So-net無料ブログ作成

セル幅、高さに合わせて画像挿入するマクロの実験 LibreOffice Calc Basic [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

 

PIC_Insert1.png

セル結合したセルに挿入


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

nice! 0

コメント 0

コメントを書く

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

トラックバック 0


Linuxランキング