LIbreofficeCalcBasic シートに複数の画像を挿入、位置の保護するマクロの実験

LIbreofficeCalcBasic シートに複数の画像を挿入、移動位置の保護するマクロの実験

訂正　移動　NG　→　位置　

ここのところ実験してきたマクロで初期の目的、複数の画像を挿入しファイル名を表示し移動位置を保護する マクロが完成した。

 

Sub PicS_insert_draw()
'ファイル選択ダイアログで複数の画像ファイルを選択して、シートに書き込む
    Dim aSize as new com.sun.star.awt.Size
    Dim aPos as new com.sun.star.awt.Point
'        drawpage =  ThisComponent.CurrentController.activesheet.getDrawPage()
'        shape = ThisComponent.createInstance("com.sun.star.drawing.GraphicObjectShape")
'oLayerManager = ThisComponent.LayerManager()
'----------------------------------------------------------------------------------------------------   
'選択範囲のサイズ、位置
    With ThisComponent.CurrentController.selection
          pX=.Position.X
         pY=.Position.Y
        sH=.Size.Height
         sW=.Size.Width
     End With
'-----------------------------------------------------------------------------------------------------
'FilePickerで複数画像URL取得
 ' ファイル選択ダイアログ 初期化
            oFilePicker = createUnoService("com.sun.star.ui.dialogs.FilePicker")
        '複数選択モードTrue
        'setMultiSelectionMode(False) →.getFiles()
        'setMultiSelectionMode(True) →selectedFiles()
            oFilePicker.setMultiSelectionMode(True)
        'フィルター　画像ファイル
            oFilePicker.appendFilter("画像ファイル","*.jpg;*.jpeg;*.png;*.gif;*.bmp")
        '表示ディレクトリ
            sDir = "file:///home/telstar/ピクチャ"
            oFilePicker.setDisplayDirectory(sDir)
    '画像選択ダイアログ表示          
            fpd=oFilePicker.execute
        'ファイルが選択されたか？　fpd=1 選択された、fpd<>1キャンセルされた
                if fpd <> 1 then
                    Exit Sub
                end if
  
    'ファイルURL取得
        For i=0 to Ubound(oFilePicker.selectedFiles())
            '選択画像をDrawPageにインサートするための設定 Loop内で
            'Loop外で設定すると連続画像挿入がうまく出来無い   
                drawpage =  ThisComponent.CurrentController.activesheet.getDrawPage()
                shape = ThisComponent.createInstance("com.sun.star.drawing.GraphicObjectShape")
            'ConvertToURLでfile://を取り除く  システムファイル名をファイルURLへ変換
                shape.GraphicURL = ConvertToURL(oFilePicker.selectedFiles(i))
            'URLからファイル名を取り出す
                oURL=oFilePicker.selectedFiles(i)
                len_URL=Len(oURL)
                    For j=len_URL To 1 Step -1
                        a=mid(oURL,j,1)
                        If a="/" Then
                            oURL=right(oURL,len_URL-j)
                    'Print oURL
                        J=1
                        End If
                    Next j
           
'-------------------------------------------------------------------------------------------------------------------
    '画像の挿入

            celHeight=452        '画像間隔　標準cell高さ
            aSize.Width = sW
            aSize.Height = sH
            aPos.X = pX
            aPos.Y = pY+(sH+celHeight)*i
            shape.Size = aSize
            shape.Position = aPos
            'Shape.LayerId = 1    '最背面に設定
            drawpage.add(shape)
            '文字の挿入
                'shape.setString("No." + (i+1))
                shape.setString(oURL)
                shape.CharColor=RGB(120,120,120)
                'shape.CharBackColor=RGB(255,255,255)
                shape.CharShadowed=true
　　　　'追記
            '文字垂直方向位置　0=top  1=center   2=bottom
                shape.TextVerticalAdjust=2
                '文字水平方向位置    0=left   1=center   2=right
                shape.TextHorizontalAdjust=2
                '下からの位置　単位100分の1ミリメートル
                shape.TextLowerDistance =300
                '右からの位置
                shape.TextRightDistance =300
               
            '移動保護
                shape.MoveProtect=true

               
            '移動位置の保護
                shape.MoveProtect=true
       
        Next i
 
End Sub