System-9

Libre Office Basic マクロ

BASICマクロでダイアログを表示し、ラジオボタン、リストボックス、ファイル選択ダイアログなどを使用するサンプルです。
このマクロでは、まずワークシートファイルをファイル選択ダイアログで必要なら複数選択します。次に、これらのファイルを順に開き、指定した列のデータを指定した行以降、データの入っている最終行までセルの値を読み取り、現在のファイルの指定した列に順に入力していきます。いくつかのファイルに分散して記録されたデータを、一つのワークシートにまとめたいという場合の処理です。
ファイルが一つ二つの場合には、一つずつ開いてコピペでいいのですが、ファイルが10や20あると、手でやるのは面倒ですよね。そういう場合のための自動処理マクロというわけです。
このマクロ内ではいろいろな要素を使用しています。ファイル選択ダイアログから受け取ったファイル名をリストボックスに追加していったり、リストボックス内の要素としてのワークシートファイル名を順に開いてデータを読み取ったり、シートの選択、セルの値の読み取りと書き込みなども行っていますので、一般的に考えられるマクロプログラムのサンプルとして、かなり広い範囲をカバーできると思います。
このサンプルの原型は、以前にExcel用VBAで作った同様の機能のマクロです。 MSOfficeからLibreOfficeに移行するためには、この程度のマクロは移植できなくてはお話にならないと思い、作ってみました。

このマクロの作成では、ダイアログとしてTestDlg1という名前で、図のようなパーツを配置したものをまず用意します。

fig

Macro Dialog

Kom., 2013

左上の枠はリストボックスです。それぞれの部品の名前はソースを見てもらえばわかりますが、次のようになっています。
リストボックス："ListBox1"
ラジオボタン："Option1"、"Option2"、"Option3"
コンボボックス："ComboBox1"、"omboBox2"
ボタン："FileBtn"、"DeleteListBtn"、"ExecuteBtn"
テキストボックス："SheetName"、"StartNum"

コンボボックスには、列名をAからZ、AAからAZあたりまで入れておきます。
"FileBtn"には実行時イベントとして、FilesProcessFileSelectBtn (document, Basic)を指定。
"DeleteListBtn"には FileListDeleteBtn (document, Basic)を指定。
"ExecuteBtn"には ExecuteMergeBtn (document, Basic)を指定。

実行時は、「FileSelect」ボタンをクリックし、ファイル選択ダイアログが表示されたら、データの入っているソース側のワークシートファイルを選択します。複数選択が可能になっています。

fig

File Chooser

Kom., 2013

次に、コピー元のデータが入っている「SheetName」を指定し、コピー元のどの列から現在のファイル(コピー先)のどの列へコピーするのか、を指定、もしコピー先にすでにデータが入っていた場合に、上書きか、追記か、何もしないかをラジオボタンで選択し、「Execute」ボタンを押して実行開始します。

<< SDメモリUSBメモリ激安　上海問屋 >>

以下はソースコードです。ダイアログも忘れずに作っておきます。

Dim ThisDoc as Object
Dim ThisSheet as Object
Dim Doc as Object
Dim oSheet as Object
Dim Dlg as Object
Dim oOption1 as Object
Dim oOption2 as Object
Dim oOption3 as Object
Dim oCheckBox1 as Object
Dim oCheckBox2 as Object
Dim oListBox1 as Object
Dim oComboBox1 as Object
Dim oComboBox2 as Object
Dim oStartNum as Object
Dim oSheetName as Object

Sub Main
    DialogLibraries.LoadLibrary("Standard")
    Dlg = CreateUnoDialog(DialogLibraries.Standard.TestDlg1)
    oListBox1 = Dlg.getControl("ListBox1")
    oOption1 = Dlg.getControl("Option1") 
    oOption2 = Dlg.getControl("Option2") 
    oOption3 = Dlg.getControl("Option3") 
    oCheckBox1 = Dlg.getControl("CheckBox1")    
    oCheckBox2 = Dlg.getControl("CheckBox2")    
    oComboBox1 = Dlg.getControl("ComboBox1")
    oComboBox2 = Dlg.getControl("ComboBox2")
    oStartNum = Dlg.getControl("StartNum")
    oSheetName = Dlg.getControl("SheetName")
    
    ThisDoc=ThisComponent
    ThisSheet=ThisDoc.Sheets.getByName("Sheet1")
     oOption1.State=True
    'フォームを表示する
    Dlg.execute()
    Dlg.endExecute()
End Sub

Function FileOpenDialog(title as String) as String
    filepicker = createUnoService("com.sun.star.ui.dialogs.FilePicker") 
    filepicker.initialize(Array(com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE))
    filepicker.Title = title 
    filePicker.appendFilter("CSV FIles(csv,txt)","*.csv;*.txt;*.java")
    filepicker.execute() 
    files = filepicker.getFiles() 
    FileOpenDialog=files(0) 
End function

Dim getFiles(500)
Dim getFilesURL(500)
Sub FilesProcessFileSelectBtn
    'Subroutine of Openning Multipul Files using FilePicker
    'This Sub gets FileNames with Full-Path from the dialog and put them into 
    ' a global array  getFiles().
    Dim sFiles()
    Dim Array(1) as Integer
    Dim nCount as Integer
    Dim FileProperties()  As New com.sun.star.beans.PropertyValue
    Array(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
    oFilePicker = createUnoService( "com.sun.star.ui.dialogs.FilePicker" )
     strUrl = convertToUrl("D:\")
    With oFilePicker
        .initialize( Array() )
        'Windows Vista 以降のOSでは、.setDisplayDirectory()は
        'メニュー-ツール-OpenOffice.orgの全般の「開く」ダイアログと「保存」ダイアログの 
        'OpenOffice.org ダイアログを使用するにチェックを入れる。
          .setDisplayDirectory(strUrl)
        .appendFilter( "Calcドキュメント", "*.xls;*.ods" )
        .setMultiSelectionMode(True) '複数ファイル選択
    End With
     nAccept = oFilePicker.execute()
      If nAccept > 0 Then
         sFiles() = oFilePicker.getFiles()
        i=0        
         if UBound(sFiles())>1 then     
            For Each v In sFiles
                if i=0 then 
                     '複数ファイル選択時にはsFiles(0)に入っているのはフォルダーのパス。
                     'ただし、単一ファイル選択時はｓFile(0)にファイル名を含んだフルパスが
                     '入るので要注意。                 
                    folderPath=v
                 else
                     getFilesURL(i-1) = folderPath & v
                     getFiles(i-1) = ConvertFromURL( folderPath & v )
                     nCount = oListBox1.getItemCount()
                     oListBox1.additem(    getFiles(i-1), nCount)
                 end if
                 i=i+1
             next v
         else
             getFilesURL(0)=sFiles(0)
             getFiles(0)=ConvertFromURL(sFiles(0))
            nCount = oListBox1.getItemCount()
            oListBox1.additem(    getFiles(0), nCount)        
         end if
    end if
End Sub

Sub FileListDeleteBtn
    'リストボックス内の選択されている項目を削除する
    Dim nPos as Integer
    nPos = oListBox1.getSelectedItemPos()
    if nPos>-1 then
        oListBox1.removeItems( nPos, 1 )
    End if
End Sub

Sub ExecuteMergeBtn
    'Executeボタンをクリックしたときの処理。(マージ処理実行)
    Dim Array(1) as Integer
    Dim num as Integer, n as Integer, i as Integer
    Dim lineNum as Integer
    Dim fname
    Dim sItem As String
    Dim sColName as String
     Dim FileProperties(1)  As New com.sun.star.beans.PropertyValue
    Dim oCtrl as Object, oFrame as Object
    Dim oProp() as new com.sun.star.beans.PropertyValue
    Dim d as Variant, strWork as String, ShName as String
    Dim Cell As Object
    Dim oSheets as Object
    num=  oListBox1.getItemCount()
    startLine=Val(oStartNum.text)
    ThisDoc=ThisComponent
    ShName=oSheetName.Text
    ThisSheet=ThisDoc.Sheets.getByName(ShName)
    
    for n = 0 to num -1
        oListBox1.selectItemPos( n, True )
        sSelected = oListBox1.getSelectedItem()
        fname=ConvertToUrl(sSelected) 
         FileProperties(0).Name = "MacroExecutionMode" 
         FileProperties(0).Value = com.sun.star.document.MacroExecMode.USE_CONFIG 
         Doc=StarDesktop.loadComponentFromURL( fname,"_blank",0, FileProperties())
         oSheets = Doc.Sheets
         If Not oSheets.hasbyName(ShName) Then
             msgbox(ShName & "シートがありません。", 0, fname)
             Goto Continue 
         End If
        oSheet = Doc.Sheets.getByName(ShName)
        sColName = oComboBox1.text 'get selected item in ComboBox
         srcCol=GetColNum(oComboBox1.text)
         destCol=GetColNum(oComboBox2.text)
         for i = startLine to  GetEndRow(Doc,  oSheet, oComboBox1.text) 
              d =oSheet.getCellByPosition(srcCol , i).String
              if ThisSheet.getCellByPosition(destCol , i).String <> "" then
                  if  oOption1.State=True then  ' Overwrite
                      ThisSheet.getCellByPosition(destCol , i).String=d
                  elseif oOption2.State=True then  ' Append
                      strWork=ThisSheet.getCellByPosition(destCol , i).String
                      strWork = strWork & d
                     ThisSheet.getCellByPosition(destCol , i).String=strWork
                 elseif  oOption3.State=True  then  ' Do nothing
                  end if
            Else 
                 ThisSheet.getCellByPosition(destCol , i).String=d
            End if
         next i
        Doc.close true
Continue: 
     Next n    
End Sub

Function GetEndRow(oDc as object, oSht as object, sCol as String) as Long 'sColは"D"のように列名で指定 
    'Get end row of specified Column
    '指定列のデータが入っている最終行をLong型整数で返す。
    Dim oCursor as Object 
    Dim oCntrl as Object 
    Dim oFrame as Object 
    Dim oDispatcher as Object 
    Dim oProp(2) as new com.sun.star.beans.PropertyValue 
    Dim nShtEndRow as Long 
    Dim nEndRow as Long 
    Dim oDisp as String 
    oCursor = oSht.createCursor() 
    nShtEndRow = oCursor.getRangeAddress().EndRow 
    oCntrl = oDc.getCurrentController() 
    oFrame = oCntrl.Frame 
    oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper") ' 
    oProp(0).Name = "ToPoint" 
    oProp(0).Value = "$" & sCol & "$" & nShtEndRow 
    oProp(1).Name = "Sel" 
    oProp(1).Value = false 
    oDispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, oProp()) ' 
    oProp(0).Name = "By" 
    oProp(0).Value = 1 
    oProp(1).Name = "Sel" 
    oProp(1).Value = false 
    oDispatcher.executeDispatch( oFrame, ".uno:GoUpToStartOfData", "", 0, oProp()) 
    nEndRow = oCntrl.getSelection().getRangeAddress().EndRow ' 
    GetEndRow=nEndRow 
End Function

Sub RowSelection(oDc as object, CellName as string) 'CellName はB8 等 
    '指定した名前のセルを選択状態にする
    Dim oCtrl as Object, oFrame as Object 
    Dim oDispatcher as Object 
    Dim oProp(0) as new com.sun.star.beans.PropertyValue 
    oCtrl = oDc.getCurrentController() 
    oFrame = oCtrl.getFrame() 
    oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper") ' 
    oProp(0).Name = "ToPoint" 
    oProp(0).Value = CellName 
    oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp()) 
    oDispatcher.executeDispatch(oFrame, ".uno:SelectRow", "", 0, Array()) ' 
End Sub

Function GetRowOfSelectedCell(oDc as Object)  as Long
    '選択されているセルの行番号を返す。
    Dim oSel as Object 
    Dim oCellAddr as Object 
    Dim nActCol as Long, nActRow as Long 
    Dim nShtNo as Integer 
    oSel = oDc.CurrentController.getSelection() 
    oCellAddr = oSel.getCellAddress() 
    oActCol = oCellAddr.Column 
    nActRow = oCellAddr.Row 
    GetRowOfSelectedCell=nActRow
End Function

Function GetColumnOfSelectedCell(oDc as Object)  as Long
    '選択されているセルの列番号を返す
    Dim oDoc as Object 
    Dim oSel as Object 
    Dim oCellAddr as Object 
    Dim nActCol as Long, nActRow as Long 
    Dim nShtNo as Integer 
    oSel = oDc.CurrentController.getSelection() 
    oCellAddr = oSel.getCellAddress() 
    nActCol = oCellAddr.Column 
    nActRow = oCellAddr.Row 
    GetColumnOfSelectedCell=nActCol
End Function

Function GetColNum(strAdr as String) as Long
    '"A1"形式のセルアドレスの列番号をLong型整数で返す。(Aは0)
    Dim nChrCode as Long
    Dim  numWork as Long
    numWork=0
    for i=0 to Len(strAdr)-1
        nChrCode= ASC(UCASE(Mid(strAdr, i+1, 1)))
        if nChrCode >= ASC("A") and nChrCode <= ASC("Z") then
            numWork = numWork * 26 + nChrCode-ASC("A") +1 
        else exit for
        end if
    next i
    GetColNum= numWork-1
End Function

OpenOfficeマクロプログラミング―「Writer」「Calc」「Base」…OOoをBasicで便利に! (I・O BOOKS)

iLEDについて

Javaサンプル

Netbeans

Libre Office Basicマクロ

その他

Libre Office Basic マクロ