mieki256's diary

LibreOffice Writer 上で、画像一覧が並んだ、アルバムっぽいページを作成するマクロです。

以下のようなダイアログ上で操作をすれば…。
以下のようなページが作れます。

_album_make_macro_20140614.zip をDL・解凍して、album_make.odt を、OpenOffice / LibreOffice Writer で開いてみてください。

1. 「マクロを有効化するか？」と尋ねてくるので、有効を選びます。
2. 「アルバムを挿入」ボタンを押せば、ダイアログが開きます。
3. 「画像を追加」ボタンを押して、画像を選んでください。複数の画像を選択できます。
4. 列数その他を入力して、「画像サイズ算出」ボタンを押してください。目標画像サイズが大雑把に計算されます。
5. 「アルバム作成」ボタンを押せば、文書の最後に、表形式でアルバムが挿入されます。

「アルバムを挿入」ボタンそのものは、印刷には出ない設定にしてありますので、印刷時にわざわざボタンを削除しなくてもOKです。

• Windows7 x64
• LibreOffice Writer 4.2.4.2
• Apache OpenOffice Writer 4.1.0

Apache OpenOffice 上で動かすと、画像の追加時に反応が鈍いようです。リストボックス内の表示がぺろんぺろんとのんびり変化していくようで…。

ooo BASIC 部分は以下の通り。

_make_album.bas

ダイアログ部分は以下の通り。

_MakeAlbumDialog.xdl

一応、ソースの中身も列挙しておきます。実験用のコードも多々残ってますが…。

OPTION EXPLICIT

Public oDialog as Object
Public oListBox as Object
Public oField1 as Object
Public oField2 as Object
Public oField3 as Object
Public oField4 as Object
 
Sub Main

    ' 表示するダイアログを指定
    DialogLibraries.LoadLibrary("Standard")
    oDialog = CreateUnoDialog(DialogLibraries.Standard.MakeAlbumDialog)
    
    oListBox = oDialog.getControl("ListBox1")
    oField1 = oDialog.getControl("Field1")
    oField2 = oDialog.getControl("Field2")
    oField3 = oDialog.getControl("Field3")
    oField4 = oDialog.getControl("Field4")
    
    ' ダイアログを表示
    If oDialog.execute() = 1 Then
        ' OKボタンが押された
        
        Dim itemSize as Integer
        
        itemSize = oListBox.getItemCount()  ' リストボックス項目数を取得
        If itemSize > 0 Then
            Dim oDoc as Object
            Dim oTbl as Object
            Dim oUndoMng as Object
            
            oDoc = ThisComponent
            
            ' Undo制御
            oUndoMng = oDoc.getUndoManager()
            
            ' undo コンテキストの開始
            oUndoMng.enterUndoContext("Undo Make Album Macro")

            ' 表を新規作成
            MakeNewtable(GetTableColSize(), itemSize, GetTableMargin())
            
            oTbl = GetTable
            If IsEmpty(oTbl) Then
                MsgBox "表が見つかりません"
            Else
                ' 表内に要素を挿入
                AccessRowColumns(oTbl, GetImageTargetSize())
            End If
            
            ' undo コンテキストを終了
            oUndoMng.leaveUndoContext()
        End If
    Else
        ' Cancelボタンが押された
        Exit Sub
    End If
    
End Sub

' 表の列数を取得
Function GetTableColSize
    GetTableColSize = CInt(oField1.getText())
End Function

' 画像目標サイズを取得
Function GetImageTargetSize
    GetImageTargetSize = CInt(oField2.getText())
End Function

' 表の左右マージン値を取得
Function GetTableMargin
    GetTableMargin = CInt(oField3.getText())
End Function

' 画像の左右マージン値を取得
Function GetImageMargin
    GetImageMargin = CInt(oField4.getText())
End Function

' ----------------------------------------
' ファイル選択ダイアログを開く

Sub SelectFile
    Dim f as Object
    
    f = createUnoService("com.sun.star.ui.dialogs.FilePicker")
    f.initialize( Array(com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE))
    
    ' ファイルの複数選択を可能にする
    f.setMultiSelectionMode(True)
    
    ' 表示フィルタを追加
    f.appendFilter("All Files (*.*)", "*.*")
    f.appendFilter("Image File", "*.bmp;*.jpg;*.gif;*.png")
    f.setCurrentFilter("Image File")    ' デフォルトフィルタを指定
    
    If f.execute() = 1 Then
        ' 選択された
        Dim sz as Integer
        Dim i as Integer
        Dim sFilePath as String
        
        sz = Ubound(f.selectedFiles())
        
        For i = 0 To sz
            Dim nCnt as Integer
            
            ' sFilePath = ConvertFromURL(f.selectedFiles(i)) 
            sFilePath = f.selectedFiles(i)
            
            ' リストボックスに追加
            nCnt = oListBox.getItemCount()
            oListBox.addItem(sFilePath, nCnt)
        Next i
    End If
        
End Sub

' ----------------------------------------
' 1セルの幅を大雑把に取得

Sub CalcImageSize
    Dim pw as Long
    Dim cols as Integer
    Dim iw as Long
    
    ' ページ横幅を取得
    pw = GetPagePrintWidth()
    
    ' 表の左右マージン分を減らす
    pw = pw - (GetTableMargin() * 2)
    
    ' 表の列数を取得
    cols = CInt(oField1.getText())

    ' 列数で割る
    iw = pw / cols
    
    ' 画像の左右マージン分を減らす
    iw = iw - (GetImageMargin() * 2)

    ' 画像サイズ指定用 InputBox に代入
    oField2.setText(CStr(iw))
End Sub

' ----------------------------------------
' 最後に挿入した表を取得

Function GetTable
    Dim oDoc as Object
    Dim oTbls as Object
    
    oDoc = ThisComponent
    oTbls = oDoc.TextTables
    If oTbls.hasElements = False Then
        ' 表が無い
        GetTable = Empty
    Else
        ' 1つ目の表オブジェクトを取得する場合
        ' oTbl = oTbls.getByIndex(0)
        
        ' 最後に挿入した表を取得する場合
        GetTable = oTbls.getByIndex(oTbls.getCount() -1)
    End If
End Function

' ----------------------------------------
' 表を新規作成
'
Sub MakeNewTable(iCols as Integer, iCellMax as Integer, margin as Integer)
    Dim oDoc as Object
    Dim iRows as Integer
    Dim oTbl as Object
    Dim oCurs as Object
    
    ' 文書を新規作成する場合
    ' Dim Dummy()
    ' oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
    
    ' 現在開いてる文書を対象にする場合
    oDoc = ThisComponent

    ' 行数を算出    
    iRows = iCellMax / iCols
    If iCellMax - (iRows * iCols) > 0 Then iRows = iRows + 1
    iRows = iRows * 2

    ' 表オブジェクトを作成
    oTbl = oDoc.createInstance("com.sun.star.text.TextTable")
    oTbl.setName("AlbumTable")
    oTbl.initialize(iRows, iCols)

    ' サイズを指定
    oTbl.HoriOrient = 0 ' com.sun.star.text.HoriOrientation.NONE
    oTbl.LeftMargin = margin
    oTbl.RightMargin = margin
    
    ' 文書の最終位置に表オブジェクトを挿入
    oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTbl, False)
    
    ' 枠線を設定
    ' SetTableBorder(oTbl)
End Sub

' ----------------------------------------
' 表の枠線設定を変更する
'
Sub SetTableBorder(oTbl)
    Dim border as Object
    
    border = oTbl.TableBorder
    border.TopLine.OuterLineWidth = 0
    border.BottomLine.OuterLineWidth = 0
    oTbl.TableBorder = border
End Sub

' ----------------------------------------
' 行と列にアクセスする
'
Sub AccessRowColumns(oTbl as Object, iw as Long)
    Dim ridx as Integer
    Dim cidx as Integer
    Dim rcnt as Integer
    Dim ccnt as Integer

    Dim i as Integer
    i = 0

    rcnt = oTbl.getRows.getCount()      ' 行数
    ccnt = oTbl.getColumns.getCount()   ' 列数

    For ridx = 1 to rcnt
        For cidx = 1 to ccnt
        
            Dim cellname as String
            Dim cell as Object
            
            cellname = Chr(64 + cidx) & ridx    ' "A1" "B2" 等のセル名を生成
            cell = oTbl.getCellByName(cellname) ' セルにアクセス
            
            If ridx mod 2 = 0 Then
                ' 作者名等記入欄
                
                ' セル内を縦方向で上揃えにする
                cell.VertOrient = com.sun.star.text.VertOrientation.TOP
            Else
                ' 画像欄
                
                If i < oListBox.getItemCount() Then
                    
                    ' 画像ファイル名をリストボックス内から取得
                    Dim sUrl as String
                    oListBox.selectItemPos(i, True)
                    sUrl = oListBox.getSelectedItem()
        
                    ' セル内容を変更する例。行:列を挿入
                    ' cell.string = CStr(ridx) & " : " & CStr(cidx)
                    
                    ' 画像を挿入
                    InsertTextGraphic(oTbl, cidx - 1, ridx - 1, sUrl, iw)
                    
                    i = i + 1
                End If
                
                ' セル内を縦方向でセンタリング
                cell.VertOrient = com.sun.star.text.VertOrientation.CENTER
            End If
            
            ' セル内を横方向でセンタリング
            cell.createTextCursor().paraAdjust = com.sun.star.style.ParagraphAdjust.CENTER
        Next
    Next
End Sub

' ----------------------------------------
' 画像を挿入

Sub InsertTextGraphic(oTbl, col, row, sUrl, iTargetSize)
    Dim oDoc as Object
    Dim dispather as Object
    Dim oText as Object
    Dim oViewCursor as Object
    Dim aSize
    Dim aArgs(0) As New com.sun.star.beans.PropertyValue
    Dim oGp as Object
    Dim oImage as Object
    Dim oTxtGrp as Object
    
    oDoc = ThisComponent
    oViewCursor = oDoc.getCurrentController().getViewCursor()
    
    oGp = CreateUnoService("com.sun.star.graphic.GraphicProvider")
    
    aArgs(0).Name = "URL"
    aArgs(0).Value = sUrl
    oImage = oGp.queryGraphic(aArgs)
    oTxtGrp = oDoc.createInstance("com.sun.star.text.TextGraphicObject")
    oTxtGrp.Graphic = oImage
    aSize = oImage.Size
    ' Print aSize.Width & " x " & aSize.Height

    Dim fScale as Double
    If aSize.Width > aSize.Height Then
        fScale = CDbl(iTargetSize) / aSize.Width
    Else
        fScale = CDbl(iTargetSize) / aSize.Height
    End If
    aSize.Width = CLng(aSize.Width * fScale)
    aSize.Height = CLng(aSize.Height * fScale)
    
    With oTxtGrp
        .setSize(aSize)
        .VertOrient = com.sun.star.text.VertOrientation.CENTER
        .HoriOrient = com.sun.star.text.HoriOrientation.CENTER
        ' .VertOrientRelation = com.sun.star.text.RelOrientation.PAGE_PRINT_AREA
        ' .HoriOrientRelation = com.sun.star.text.RelOrientation.PAGE_PRINT_AREA
        ' .Surround = com.sun.star.text.WrapTextMode.THROUGHT
        
        ' 画像を文字として挿入
        .AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
    End With
    
    Dim oCell as Object
    oCell = oTbl.getCellByPosition(col, row) ' 列、行で指定
    ' oDoc.getCurrentController().select(oCell)
    
    oCell.getText.insertTextContent(oCell, oTxtGrp, True)
End Sub

' 画像挿入のテスト
Sub InsertTextGraphicTest
    Dim oTbl as Object
    Dim sUrl as String
    Dim fScale as Single
    sUrl = "file:///C:/home/Pictures/pub_pictures/pcd01.jpg"
    fScale = 2540.0 / 3
    oTbl = GetTable
    InsertTextGraphic(oTbl, 0, 0, sUrl, fScale)
End Sub

' ----------------------------------------
' 表内のカーソル位置を取得、その1

Sub GetPosInTable
    Dim oDoc as Object
    Dim oTbl as Object
    Dim oVCur as Object
    Dim oCurCell as Object
    Dim oDisp as String
    
    oDoc = ThisComponent
    oVCur = oDoc.getCurrentController().getViewCursor()
    If IsEmpty(oVCur.TextTable) Then
        Print "The cursor is NOT in a table"
    Else
        oTbl = oVCur.TextTable
        oDisp = "The cursor is in cell " & oVCur.Cell.CellName
        Msgbox(oDisp, 0, "Curor Position in Table")
    End If
End Sub

Function InTable
    Dim oDoc as Object
    Dim oVCur as Object
    
    oDoc = ThisComponent
    oVCur = oDoc.getCurrentController().getViewCursor()
    If IsEmpty(oVCur.TextTable) Then
        CheckPosInTable = Empty
    Else
        CheckPosInTable = oVCur.Cell
    End If
End Function

' ----------------------------------------
' 表内に画像を文字として挿入してみる例

Sub InsertGraphicToTbl
    Dim oDoc as Object
    Dim oTbl as Object
    Dim oImage as Object
    Dim oCell as Object
    Dim sUrl as String
    
    sUrl = "file:///C:/home/Pictures/pub_pictures/pcd02.jpg"
    oDoc = ThisComponent
    oTbl = GetTable
    oImage = oDoc.createInstance("com.sun.star.text.GraphicObject")
    oImage.GraphicURL = sUrl
    oImage.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
    oImage.Width = 3000
    oImage.Height = 3000
    
    oCell = oTbl.getCellByPosition(0,0)
    oCell.getText.insertTextContent( oCell, oImage, False )
End Sub

' ----------------------------------------
' 画像をリンク形式で挿入する例

Sub InsertTextGraphicLink(sUrl as String, enableChara as Boolean)
    Dim oDoc as Object
    Dim oViewCursor as Object
    Dim oImage as Object
    Dim aSize As New com.sun.star.awt.Size
    
    oDoc = ThisComponent
    oViewCursor = oDoc.getCurrentController().getViewCursor()
    aSize.Width = 2000
    aSize.Height = 2000
    oImage = oDoc.createInstance("com.sun.star.text.TextGraphicObject")
    oImage.GraphicURL = sUrl
    oImage.Size = aSize
    
    If enableChara Then
        ' 画像を文字として挿入
        oImage.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
    End If
    
    ' 表内には挿入できない
    oDoc.Text.insertTextContent(oViewCursor, oImage, False)
End Sub

Sub InsertTextGraphicLinkTest
    InsertTextGraphicLink("file:///C:/home/Pictures/pub_pictures/pcd03.jpg", True)
End Sub

' ----------------------------------------
' 画像のサイズを取得
'
' OOoBasic/Generic/Image - ...?
' http://hermione.s41.xrea.com/pukiwiki/index.php?OOoBasic%2FGeneric%2FImage

Function GetImageSize(sUrl)
    Dim oGP as Object
    Dim oSFA as Object
    Dim oImgInput as Object
    Dim oGraphic as Object
    Dim aSizePixel as Object
    Dim aSize(2) as Integer
    
    oGP = CreateUnoService("com.sun.star.graphic.GraphicProvider")
    oSFA = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
    oImgInput = oSFA.openFileRead(sUrl)
    
    Dim aImgDesc(0) As New com.sun.star.beans.PropertyValue
    aImgDesc(0).Name = "InputStream"
    aImgDesc(0).Value = oImgInput
    oGraphic = oGP.queryGraphic(aImgDesc)
    aSizePixel = oGraphic.SizePixel

    aSize(0) = aSizePixel.Width
    aSize(1) = aSizePixel.Height
    oImgInput.closeInput()
    GetImageSize = aSize
End Function

Sub GetImageSizeTest
    Dim ret(2) as Integer
    ret = GetImageSize("file://C:/home/Pictures/pub_pictures/pcd09.jpg")
    msgbox "Width x height = " & CStr(ret(0)) & " x " & CStr(ret(1))
End Sub

' ----------------------------------------
' 表の幅を取得してみるテスト
'
' 表を新規作成した場合、巨大な値しか返ってこない…

Sub GetCellSize
    Dim oDoc as Object
    Dim oTbl as Object
    Dim csize as Integer
    Dim w as Integer
    Dim tw as Long
    Dim margin as Long

    margin = 100
    
    oDoc = ThisComponent
    oTbl = GetTable
    
    ' print oTbl.TableColumnRelativeSum
    
    If False Then
        ' 表の幅を、左マージン・右マージン指定により設定し直す
        oTbl.HoriOrient = com.sun.star.text.HoriOrientation.NONE
        oTbl.LeftMargin = margin
        oTbl.RightMargin = margin
    End If

    ' 列数を取得
    csize = oTbl.getColumns.getCount()

    ' 表の幅を取得
    tw = oTbl.Width
    ' tw = oTbl.RelativeWidth

    Dim oTblColSeps
    oTblColSeps = oTbl.TableColumnSeparators 
    ' print "ColumnSeparators (1) = " & oTblColSeps(1).Position

    w = tw / csize - 400
    print "Table Width = " & tw & "  cell w = " & w
    
End Sub

' ----------------------------------------
' ページの印刷可能範囲の横幅を取得

Function GetPagePrintWidth
    Dim oDoc As Object
    Dim oStyleFamilies As Object
    Dim oPageStyles As Object
    Dim oPageStyle As Object
    Dim pagePrintWidth as Long
    
    oDoc = ThisComponent
    oStyleFamilies = oDoc.StyleFamilies
    oPageStyles = oStyleFamilies.getByName("PageStyles")
    oPageStyle = oPageStyles.getByName("Standard")
    
    pagePrintWidth = oPageStyle.Width - oPageStyle.LeftMargin - oPageStyle.RightMargin
    
    ' print pagePrintWidth
    
    GetPagePrintWidth = pagePrintWidth
End Function

' ----------------------------------------
' ページスタイルを取得してみるテスト

Sub pagestylescontainer_elements
    Dim oDoc As Object
    Dim oStyleFamilies As Object
    Dim oPageStyles As Object
    Dim oPageStyle As Object
    Dim aStyleNames() As String
    Dim i As Integer
    Dim str as String
    Dim pagePrintWidth as Long
    
    oDoc = ThisComponent
    oStyleFamilies = oDoc.StyleFamilies
    oPageStyles = oStyleFamilies.getByName("PageStyles")
    aStyleNames() = oPageStyles.getElementNames()

    str = ""
    For i = 0 To UBound(aStyleNames())
        str = str & aStyleNames(i) & Chr(10)
    Next i
    MsgBox str
    
    oPageStyle = oPageStyles.getByName("Standard")
    print "page width = " & oPageStyle.Width
    print "page left  margin = " & oPageStyle.LeftMargin
    print "page right margin = " & oPageStyle.RightMargin
    
    pagePrintWidth = oPageStyle.Width - oPageStyle.LeftMargin - oPageStyle.RightMargin
    print "page width = " & oPageStyle.Width & "   print width = " & pagePrintWidth
End Sub

_Macroの一歩(「Macro使い」への8分間)
_OSS( Open Source Software )でいこう!!「　OpenOffice.org / LibreOfficeを使おう編　」
_OpenOffice.org Basic - Wikibooks
_OOoBasic - ...?
_[Solved] Writer macro to insert an image into a table cell (View topic) - Apache OpenOffice Community Forum
_OpenOffice.org BASIC プログラミングガイド - Apache OpenOffice Wiki
_文書ドキュメント: テキスト以外のオブジェクト - Apache OpenOffice Wiki
_LibreOffice Calc Basic fun!!!: リストボックスを操作する (1)
_System-9 - Libre Office Basic マクロ 1
_System-9 - Libre Office Basic マクロ 6
_グローバル変数を使用してマクロを分かりやすくする　LibreOffice Calc Basic：ubuntu10-12 LibreOffice4：So-netブログ
_Service TextTable

どう書けばいいのか分からなくて結局諦めてしまったのですが、LibreOffice Writer 上で、表(TextTable)の横幅、もしくはセルの横幅が取得できないという問題が残っていて。セル一つ分の横幅を取得したいけどやり方が分からず。であれば、表の横幅を列数で割れば求められるかな、と思ったのだけど、これも上手く行かず。

表を新規作成して挿入した直後、.Width で表の横幅を取得すると、とんでもなく大きな値(Long値)が返ってきてしまう。これでは計算に使えない…。ややこしいことに、マウスで表の外枠をちょっとでもドラッグして表のサイズを変更した後なら、Integer で収まる値が返ってくるようになる。どうしてこんなことになるのか…。訳が分かりません。

仕方ないので、ページ横幅やページ余白から、表の横幅を大雑把に求めて誤魔化してみたけれど。表の横幅、もしくはセルの横幅を取得できればもっとすっきり書けそう。

困ったことに、「openoffice cell width」等で検索しても、Openoffice Calc (表計算ソフト)の情報ばかり出てきてしまう。Calc じゃなくて Writer(ワープロソフト)上でどう書けばいいのかを知りたいのだけど…。

ダイアログ上で、OKボタン、キャンセルボタンを押した際に違う値が返ってくる、と解説ページには書いてあったのだけど。そのOKボタン、キャンセルボタンってどれよ…。と思ったら、フツーにボタンを配置して、ボタンの種類を、OK/キャンセルに設定すればよかったようで。

Writer上の表・セルの中で、縦方向にセンタリング(中央揃え)をする方法が分からなかったのだけど。

 cell.VertOrient = com.sun.star.text.VertOrientation.CENTER

といった指定でできるらしい、とメモ。