ファイル選択ダイアログでファイルURLを調べる Libreoffice4.4 Basic

ファイル選択ダイアログでファイルフルパスを調べる　Libreoffice4.4 Basic

以前書いた記事で、ファイル選択ダイアログでファイルフルパスを調べるマクロがLIbreoffice4.4になったらエラーがでるようになったので修正した。

 

selectedfiles を　getfiles に修正する

 

 画像の挿入マクロ修正版

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")
    '画像選択ダイアログ表示         
        fpd=filePickerDlg.execute
        'ファイルが選択されたか？　fpd=1 選択された、fpd<>1キャンセルされた
            if fpd <> 1 then
                Exit Sub
            end if
    '挿入画像ファイルのパス
            url1=filePickerDlg.getFiles　　　　　　'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


   

 

 

タグ：画像の挿入

コメント 3

Over Night Presidone <a href=https://abcialisnews.com/#>buy cialis online</a> Kamagra Oral Jelly Kaufen Gunstig <a href=https://abcialisnews.com/#>Cialis</a> Achat Levitra En France
by Janinsessy (2020-04-25 06:44) 

Online Synthroid Purchase https://agenericcialise.com/ - Generic Cialis Vente Misoprostol20mg <a href=https://agenericcialise.com/#>buy cialis generic online cheap</a> Pyridium Best Buy Cheapeast Express Delivery
by Bupsfutty (2020-06-15 06:35) 

Viagra Rezeptfrei Serios https://bbuycialisss.com/ - Cialis order cheap cialis online <a href=https://bbuycialisss.com/#>Cialis</a> Precio De Kamagra Con Receta
by SWADWAY (2020-06-21 10:48)