So-net無料ブログ作成

選択セル範囲幅に合わせて画像を挿入するマクロの実験 LibreOffice Calc Basic [LibreOffice Calc Basic]

選択セル範囲幅に合わせて画像を挿入するマクロの実験 LibreOffice Calc Basic

追記 こちらもご覧ください   http://j11.blog.so-net.ne.jp/2016-06-16

 

Sub Pic_insert2()
    'ファイル選択ダイアログを開いて、画像フォーマットファイルを選択
    '選択セル位置に画像を挿入
    '選択セル幅に合わせてリサイズ(縦横比維持) する実験

    dim oDoc as Object
    dim dispather as Object
    dim filePickerDlg as Object
  
    ' 設定
        oDoc = ThisComponent.CurrentController.Frame
        dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

    ' ファイル選択ダイアログ 初期化
        filePickerDlg = createUnoService("com.sun.star.ui.dialogs.FilePicker")
        'フィルター 画像ファイル
            filePickerDlg.appendFilter("画像ファイル","*jpg;*.jpeg;*.png;*.gif;*.bmp")   '訂正 *jpgのあとに . を追加

   '画像選択ダイアログ表示          
        fpd=filePickerDlg.execute
        'ファイルが選択されたか? fpd=1 選択された、fpd<>1キャンセルされた
            if fpd <> 1 then
                Exit Sub
            end if
    '挿入画像ファイルのパス
            url1=filePickerDlg.selectedFiles  '訂正 selectedFiles → getfiles()
  
    '画像をカーソル位置(セル左上)に挿入  
        document   = ThisComponent.CurrentController.Frame
        dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
        dim args1(0) as new com.sun.star.beans.PropertyValue
            args1(0).Name = "FileName"
            args1(0).Value = ConvertToURL(url1(0))
        '画像の挿入
            dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args1())
        '画像のサイズ取得
            'DrawPageから画像取得
                get_drowpage = ThisComponent.CurrentController.activesheet.getDrawPage
                get_index = get_drowpage.getByIndex(get_drowpage.getCount-1)
        '画像のサイズ
            Dim Psize as new com.sun.star.awt.Size
            Dim hiritu
            Dim PicSizeW,PicSizeH
                PicSizeW= get_index.getSize.Width
                PicSizeH= get_index.getSize.Height
            '横縦比
                hiritu=PicSizeH/PicSizeW
   
          
    '挿入画像のリサイズ、セル幅、高さに合わせる(縦横比は維持しない)
                Dim oCursor As Object
                Dim oSelection As Object
                Dim w As Long
                Dim h As Long
        'object Selection,Cursol
            oSheet=ThisComponent.CurrentController.ActiveSheet
            oSelection = ThisComponent.CurrentSelection
            oCursor = oSheet.createCursorByRange( oSelection )    'セルの左上のポジションXY
            oCursor.collapseToMergedArea()                                    'collapseToMergedArea メソッドでセルカーソルを結合された                           ’セルの範囲に広げます

        'カーソルの幅、高さを調べる
            w=oCursor.Size.Width
            h=oCursor.Size.height
        'DrawPageから画像取得
            get_drowpage = ThisComponent.CurrentController.activesheet.getDrawPage
            get_index = get_drowpage.getByIndex(get_drowpage.getCount - 1)
        'リサイズ
            Psize.Width = w
            Psize.Height = w*hiritu
        'リサイズ実行
            get_index.setSize(Psize)
  
End Sub

PICinsertCellW.png

 

追記 上記のマクロに記述ミスがあったので訂正

 

 Sub Pic_insert3()
    'ファイル選択ダイアログを開いて、画像フォーマットファイルを選択
    '選択セル位置に画像を挿入
    '選択セル幅に合わせてリサイズ(縦横比維持) する実験

    dim oDoc as Object
    dim dispather as Object
    dim filePickerDlg as Object
 
    ' 設定
        oDoc = ThisComponent.CurrentController.Frame
        dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

    ' ファイル選択ダイアログ 初期化
        filePickerDlg = createUnoService("com.sun.star.ui.dialogs.FilePicker")
        'フィルター 画像ファイル
            filePickerDlg.appendFilter("画像ファイル" , "*.jpg;*.jpeg;*.png;*.gif;*.bmp")
    '画像選択ダイアログ表示          
        fpd=filePickerDlg.execute
        'ファイルが選択されたか? fpd=1 選択された、fpd<>1キャンセルされた
            if fpd <> 1 then
                Exit Sub
            end if
    '挿入画像ファイルのパス
            sFiles=filePickerDlg.getFiles()
            'msgbox sFiles(0)
 
    '画像をカーソル位置(セル左上)に挿入  
        document   = ThisComponent.CurrentController.Frame
        dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
        dim args1(0) as new com.sun.star.beans.PropertyValue
            args1(0).Name = "FileName"
            args1(0).Value = ConvertToURL(sFiles(0))
        '画像の挿入
            dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args1())
        '画像のサイズ取得
            'DrawPageから画像取得
                get_drowpage = ThisComponent.CurrentController.activesheet.getDrawPage
                get_index = get_drowpage.getByIndex(get_drowpage.getCount-1)
        '画像のサイズ
            Dim Psize as new com.sun.star.awt.Size
            Dim hiritu
            Dim PicSizeW,PicSizeH
                PicSizeW= get_index.getSize.Width
                PicSizeH= get_index.getSize.Height
            '横縦比
                hiritu=PicSizeH/PicSizeW
   
          
    '挿入画像のリサイズ、セル幅、高さに合わせる(縦横比は維持しない)
                Dim oCursor As Object
                Dim oSelection As Object
                Dim w As Long
                Dim h As Long
        'object Selection,Cursol
            oSheet=ThisComponent.CurrentController.ActiveSheet
            oSelection = ThisComponent.CurrentSelection
            oCursor = oSheet.createCursorByRange( oSelection )    'セルの左上のポジションXY
            oCursor.collapseToMergedArea()                                    'collapseToMergedArea メソッドでセルカーソルを結合された                           ’セルの範囲に広げます

        'カーソルの幅、高さを調べる
            w=oCursor.Size.Width
            h=oCursor.Size.height
        'DrawPageから画像取得
            get_drowpage = ThisComponent.CurrentController.activesheet.getDrawPage
            get_index = get_drowpage.getByIndex(get_drowpage.getCount - 1)
        'リサイズ
            Psize.Width = w
            Psize.Height = w*hiritu
        'リサイズ実行
            get_index.setSize(Psize)
 
End Sub

 

 


nice!(0)  コメント(0)  トラックバック(0) 
共通テーマ:パソコン・インターネット

nice! 0

コメント 0

コメントを書く

お名前:[必須]
URL:
コメント:
画像認証:
下の画像に表示されている文字を入力してください。

トラックバック 0


Linuxランキング