選択セル範囲幅に合わせて画像を挿入するマクロの実験 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

 

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

 

 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

 

 

タグ：セルに画像挿入

コメント 1

Mambo 36 Tadalafil 20 Mg enricE https://bbuycialisss.com/# - buy cheap generic cialis online EcoloSef Viagra Pfizer 100 Nuhtrath <a href=https://bbuycialisss.com/#>Buy Cialis</a> Jepguase Buy Levitra?20mg
by SWADWAY (2020-07-12 23:39)