セル幅、高さに合わせて画像挿入するマクロの実験 LibreOffice Calc Basic

セル幅、高さに合わせて画像挿入するマクロの実験　LibreOffice Calc Basic

• つぎはぎでマクロを作成したので・・・・
  
• 画像の縦横比は維持しない
• 連続挿入ではない
• 以上は今後の課題
• 
  

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

    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")
        '複数選択モードTrue
            'filePickerDlg.setMultiSelectionMode(True)
        'フィルター　画像ファイル
            filePickerDlg.appendFilter("画像ファイル","*jpg;*.jpeg;*.png;*.gif;*.bmp")
    '画像選択ダイアログ表示           
        fpd=filePickerDlg.execute
        'ファイルが選択されたか？　fpd=1 選択された、fpd<>1キャンセルされた
            if fpd <> 1 then
                Exit Sub
            end if
   
    '画像をカーソル位置（セル左上）に挿入   
        document   = ThisComponent.CurrentController.Frame
        dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
        '挿入画像ファイルのパス
            url1=filePickerDlg.selectedFiles
        dim args1(0) as new com.sun.star.beans.PropertyValue
            args1(0).Name = "FileName"
            args1(0).Value = ConvertToURL(url1(0))
            'args1(0).Value = url1
        '画像の挿入
            dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args1())
           
    '挿入画像のリサイズ、セル幅、高さに合わせる(縦横比は維持しない）
                Dim oSheet As Object
                Dim oCursor As Object
                Dim oSelection As Object
                Dim w As Long
                Dim h As Long
        'object　Sheet,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)
        'リサイズ
        dim Psize as new com.sun.star.awt.Size
            Psize.Width = w
            Psize.Height = h
        'リサイズ実行
            get_index.setSize(Psize)
   
End Sub

 

セル結合したセルに挿入

タグ：セルに画像挿入