ロゴ(青) OOo Basic ロゴ(緑)

[ VBA ユーザーの為の OpenOffice.org 備忘録 ]

  [UserFunc] は【マイマクロ > Standard 】に入れて利用してください。
  将来的には 『OOo 版 kt関数アドイン』に収録してリリースする予定です。

  ここに掲載しているのは OOo 3.0.0 で確認してある機能です。
  OOo はバージョンアップに伴って、かなり機能改善が施されています。ネットで公開されている解説サイトの資料は、その書かれた時期によって
  1.x 系 , 2.x 系 , 3.x 系 を対象とするものが混在しています。その為、あるサイトでは 「それは出来ない。難しい処理が必要」 と説明されていた
  ものが、他のサイトでは 「プロパティ/メソッド がある」 と書かれているケースも多々あります。ここに掲載している処理も後のバージョンでは簡単な
  プロパティ/メソッド で対応されるものも出て来るでしょう。ひとつの解説サイトだけではなく、複数の解説サイトを比較して勉強することをお勧めします。


  【  VBA  vs  OOo.Basic    対比表 】    ユーザー定義関数の一覧  
    ( ■: OOo 備忘録 ,★: はにゃ?さんの OOo Wiki 等 他サイト )

【 VBA 】 【 OOo.Basic 】
   OBJECT.getXXXX() , OBJECT.setXXXX() [メソッド]
      イコール OBJECT.XXXX [プロパティ]
UserForm (VBA) / Dialog (OOo)
 Load UserForm1  DialogLibraries.LoadLibrary ( "Standard" )
 oDialog = CreateUnoDialog (  DialogLibraries.Standard.Dialog1 )
 UserForm1.Show  oDialog.execute()
 UserForm1.Hide  oDialog.endExecute()
 UnLoad UserForm1  oDialog.dispose()
 Controls ("TextBox1")  oDialog.getControl ("TextField1")
 〜 モデル 〜
 oDialog.getControl("TextField1").Model    or
 oDialog.Model.getByName("TextField")
 Controls ("TextBox1").Parent  oDialog.getControl ("TextField1").Context
 Label1.Font.Bold = True
 Label1.Font.Bold = False
 oLabel1.Model.FontWeight = com.sun.star.awt.FontWeight.BOLD
 oLabel1.Model.FontWeight = com.sun.star.awt.FontWeight.NORMAL
 TextBox1.Enabled = True/False

 MsgBox  TextBox1.Enabled
 oTextField1.Enable = True/False
   or    oTextField1.setEnable ( True/False )
 MsgBox  oTextField1.isEnabled
 TextBox1.Visible = True/False

 MsgBox  TextBox1.Visible
 oTextField1.Visible = True/False
   or    oTextField1.setVisible ( True/False )
 MsgBox  oTextField1.isVisible
 RefEdit コントロール  Range Selection Dialog 汎用ツール
 (擬似)コントロール配列&イベント  複数コントロール間でのイベント共有が可能
 Sub TextBox1_Exit _
      ( ByVal Cancel As MSForms.ReturnBoolean )
 If Not IsNumeric( TextBox1.Value ) Then
   Cancel = True
 Sub TextField1_focusLost _
    ( oEvent As com.sun.star.awt.FocusEvent )
 If Not IsNumeric( oEvent.Source.Model.Text ) Then
   oEvent.Source.setFocus
 OptionButton のグループ分け
  (GroupName指定  or  フレーム内配置)
 OptionButton のグループ分け
   (TabIndex が連続する範囲のオプションボタンが同一グループ)
 SpinButton  マクロからの動的作成が必要
 ListBox  ( 複数列が可能 )  ListBox  ( 1列のみ  )
 ListBox1.List ( n ) = "abc"  格納済データの更新  格納済データの更新は不可。総入替が必要。
 【コントロールの右隣にサブダイアログを表示する】
 lngPosX = Me.Left + Ctrl.Left + Ctrl.Width
 lngPosY = Me.Top + Ctrl.Top
 Load SubForm
 With SubForm
   .Left = lngPosX
   .Top = lngPosY
   .StartUpPosition = 0
   .Show
 End With
 oDialogPosSize = oDialog.getPosSize()
 oCtrlPosSize = oCtrl.getPosSize()
 lngPosX = oDialogPosSize.X + oCtrlPosSize.X + oCtrlPosSize.Width
 lngPosY = oDialogPosSize.Y + oCtrlPosSize.Y

 DialogLibraries.LoadLibrary("Standard")
 oSubDialog = CreateUnoDialog(DialogLibraries.Standard.SubDialog)
 oSubDialog.setPosSize _
       (lngPosX, lngPosY, 0, 0, com.sun.star.awt.PosSize.POS)
 oSubDialog.execute()
 【プログレスバー コントロール】
 mscomctl.ocx の外部コントロールを利用
 または、ラベルで自作/アドインソフトを利用
 (詳細はリンク先参照)
 【プログレスバー コントロール】
 標準コントロールの プログレスバーコントロールを利用
 (詳細はリンク先参照)

   
Application (VBA) / StarDeskTop or Component (OOo)
 Application.ScreenUpdating = False
 Application.ScreenUpdating = True
 ドキュメントオブジェクト.LockControllers
 ドキュメントオブジェクト.UnlockControllers
 Application.CommandBars("WorkSheet Menu Bar")  『 標準メニューバーにメニュー追加 』記事を参照
 右クリックメニュー
 Application.CommandBars("Cell")
 XContextMenuInterception  (汎用マクロは こちら の記事)
 ユーザー ライブラリ パス

 strFile = Application.UserLibraryPath & "ABC.xla"

 C:\Documents and Settings\USERNAME
     \Application Data\Microsoft\AddIns\
ABC.xla
 Dim oSubstitutedPath As Object
 oSubstitutedPath = CreateUnoService _
                             ( "com.sun.star.util.PathSubstitution" )
 strURL = oSubstitutedPath.SubstituteVariables _
                             ( "$(user)/ABC.ods", True )

 file:///C:/Documents and Settings/USERNAME
               /Application Data/OpenOffice.org/3/user
/ABC.ods
 【ステータスバー上にプログレスバー】
 "■■□□"の文字表示を自分で調整する
 (詳細はリンク先参照)
 【ステータスバー上にプログレスバー】
 XStatusIndicator インターフェースでダイアログの場合と同様に
 操作できる(詳細はリンク先参照)
   
Workbook (VBA) / Document or Component (OOo)
 ThisWorkbook  ThisComponent
 ActiveWorkbook  StarDesktop.CurrentComponent (IDE から実行した場合は駄目)
   or  ThisComponent
   or  ActiveComponent  [UserFunc]
 Workbooks ("Book1.xls")  GetComponent ("Document1.ods")    [UserFunc]
 Workbooks ("Book1.xls").Activate  GetComponent ("Document1.ods", True)  [UserFunc]
 Set wkbk = Workbooks.Add  oDoc = StarDesktop.loadComponentFromURL _
             ("private:factory/scalc", "_blank", 0, Array())
 Set wkbk = Workbooks.Open _
     FileName:="C:\My Documents\ABC.xls"
 oDoc = StarDesktop.loadComponentFromURL _
      ("file:///C:/My Documents/ABC.ods", "_blank", 0, Array())
 マクロ有効確認ダイアログ付きでドキュメントを開く  Dim aArg(0) As New com.sun.star.beans.PropertyValue
 aArg(0).Name = "MacroExecutionMode"
 aArg(0).Value = _
         com.sun.star.document.MacroExecMode.USE_CONFIG
 oDoc = StarDesktop.loadComponentFromURL _
                                      (URL, "_blank", 0, aArg())

 無効で開く : NEVER_EXECUTE
 有効で開く : ALWAYS_EXECUTE_NO_WARN
 読み取り専用 & 非表示でドキュメントを開く

 その他のオプション(Name)と設定値(Value)
 Dim aArg(1) As New com.sun.star.beans.PropertyValue
 aArg(0).Name = "ReadOnly"
 aArg(0).Value = True
 aArg(1).Name = "Hidden"
 aArg(1).Value = True
 oDoc = StarDesktop.loadComponentFromUrl _
                                       (URL, "_blank", 0, aArg())
 ActiveWorkbook.Save  ThisComponent.store()
 ActiveWorkbook.SaveAs _
     Filename:="C:\My Documents\ABC.xls"
 ThisComponent.storeAsURL _
       ("file:///C:/My Documents/ABC.ods" ,Array())
 If IsNull (ActiveWorkbook.Path) Then
   ' 未保存ブック
 If ThisComponent.hasLocation Then
   '未保存ドキュメント
 If Not ActiveWorkbook.Saved Then
   ' 更新が未保存

 '更新ステータスをキャンセル(更新なし)
 ActiveWorkbook.Saved = True
 If ThisComponent.Modified Then
   ' 更新が未保存

 '更新ステータスをキャンセル(更新なし)
 ThisComponent.Modified = False
 ActiveWorkbook.Close  ThisComponent.Close(True)
 ActiveWorkbook.FullName  ThisComponent.URL
 ActiveWorkbook.Path  aURL = CreateUnoStruct("com.sun.star.util.URL")
 aURL.Complete = ThisComponent.URL
 CreateUnoService("com.sun.star.util.URLTransformer") _
                                                     .parseStrict(aURL)
 strPath = aURL.Path
   or
 vntURL = Split(ThisComponent.URL, "/")
 i = UBound(vntURL)
 ReDim Preserve vntURL(i - 1)
 strPath = Join(vntURL, "/")
 ActiveWorkbook.Name  ThisComponent.Title
   or
 vntURL = Split(ThisComponent.URL, "/")
 strName = vntURL(UBound(vntURL))
 For Each wkbk In Application.Workbooks
   MsgBox wkbk.Name
 For Each oComponent In StarDesktop.Components
   If HasUnoInterfaces _
             (oComponent, "com.sun.star.frame.XModel") then
     MsgBox oComponent.Title
   
Sheet
 ActiveSheet  ThisComponent.CurrentController.ActiveSheet
 ActiveSheet.Index  oActiveSheet = ThisComponent.CurrentController.ActiveSheet
 SheetIndex = oActiveSheet.RangeAddress.Sheet
 Worksheets ( 0 )  ThisComponent.getSheets.getByIndex ( 0 )
 Worksheets ("Sheet1")  ThisComponent.getSheets.getByName ("Sheet1")
 Worksheets ("Sheet1").Activate   SheetActivate (ThisComponent, "Sheet1")  [UserFunc]
 With ThisComponent
   oController = .getCurrentController()
   oSheet = .getSheets.getByName("Sheet1")
   oController.setActiveSheet(oSheet)
 End With
 Worksheet ("Sheet1").Parent  oSheet.DrawPage.Forms.Parent
 Worksheets ("Sheet1").ProtectContents  oSheet.isProtected
 For Each wksh In ThisWorkbook.Worksheets
   MsgBox wksh.Name
 For Each oSheet In ThisComponent.Sheets
   MsgBox oSheet.Name
 【 シート上のコントロール 】
 MsgBox  Worksheets ("Sheet1") _
     .OLEObjects ("CheckBox1").Object.Value
 oSheet=ThisComponent.getSheets.getByName("Sheet1")
 oForm=oSheet.DrawPage.Forms.getByName("Standard")
 oCheckBox = oForm.getByName("CheckBox1")
 MsgBox  oCheckBox.State
   
Cell
 Cells ( 5, 2 )    'B5  getCellByPosition ( 1, 4 )    'B5
 Range ("B5")  getCellRangeByName ("B5")
 Range ("A1").Address (True,True)  oCell.AbsoluteName
 Range ("A1").Address (False,False)  Join ( Split ( oCell.AbsoluteName, "$" ), "" )
 Range ("A1").Row       ( 値は 1 〜 )
 Range ("A1").Column   ( 値は 1 〜 )
 oCell.CellAddress.Row      ( 値は 0 〜 )
 oCell.CellAddress.Column  ( 値は 0 〜 )
 Application.Selection  [セル]  oSelection = ThisComponent.CurrentController.Selection
   or  oSelection = ThisComponent.CurrentSelection
 ActiveSheet.Range("A1").Select  oController = ThisComponent.getCurrentController()
 oSheet = oController.getActiveSheet
 oCell = oSheet.getCellRangeByName("A1")
 oController.select(oCell)
 RANGE .Offset (ROW, COLUMN)  oCell1 = oSheet.getCellRangeByName("C5")
 With oCell1.CellAddress
    oCell2 = oSheet.getCellByPosition(( .Column + 1), ( .Row + 1))
 End With
   or
 GetOffsetRange(BASE_RANGE, COLUMN, ROW [. SELECT])
 [UserFunc]
 Range("B5").Activate  Dim oCell As Object
 oCell = ThisComponent.getSheets(0).getCellRangeByName("B5")
 Call  CellActivate ( oCell )    [UserFunc]
 ActiveCell  GetActiveCell()    [UserFunc]
 ActiveCell.Offset (ROW, COLUMN).Activate  ActiveCellOffset(COLUMN, ROW)    [UserFunc]
 Range ("A1").Parent           (親 Sheet )  oCell.Spreadsheet
 Range ("A1").Parent.Parent  (親 Book )  oCell.Spreadsheet.DrawPage.Forms.Parent
 Range ("A1").Locked  oCell.CellProtection.IsLocked
 Range ("A65536").End (xlUp).Row  GetLastCell( oSheet.Columns(0) )  [UserFunc]
 Range ("A1").NumberFormat = "@"  oCell.NumberFormat = GetKeyNumberFormat ("TEXT")  [UserFunc]
 Cells.Count  GetCellsCount(oCells)    [UserFunc]
 ' セル範囲 Areas コレクション
 For Each Rng In Selection.Areas
   MsgBox Rng.Address
 ' セル範囲コンテナ
 For Each oRange In ThisComponent.CurrentSelection
   MsgBox oRange.AbsoluteName
 ' セル範囲
 For Each Cell In Range("A1:A10")
   Cell.Value = xxx
 ' セル範囲
 Dim oCellsItem() As Object
 oCells = ThisComponent.getSheets(0) _
                   .getCellRangeByName("A1:A10")
 lngCount = GetCellsItem(oCells, oCellsItem)    [UserFunc]
 For i = 1 to lngCount
   oCellsItem( i ).Value = xxx
 Next i
 Application.Intersect ( RANGE1 , RANGE2 )  oRANGE1.queryIntersection ( oRANGE2.RangeAddress )

 (注) oRANGE1/oRANGE2 の親ドキュメントが同じであるという
      確認はユーザー任せ(別ドキュメントでも動作する場合がある)
 Set rngBase = ActiveSheet.Range("B1:B10")
 Set rngTarget = ActiveSheet.Range("F1")
 rngBase.Copy Destination:=rngTarget
 oBaseRange = oActiveSheet.getCellRangeByName ("B1:B10")
 oTargetCell = oActiveSheet.getCellRangeByName ("F1")
 oSheet.copyRange(oTargetCell.CellAddress, oBaseRange.RangeAddress)
 セルデータの一括読込/一括書出
 vntArray = Range("A1:D10").Value

 Range("A1:D10").Value = vntArray
 vntArray = ThisComponent.getSheets(0) _
                    .getCellRangeByName("A1:D10").getDataArray

 ThisComponent.Sheets(0) _
           .getCellRangeByName("A1:D10").setDataArray(vntArray)
   
Basic 構文
 マクロの記録  マクロの記録
 【 Sub/Function での引数定義の注意事項 】




 ・ オプション引数と IsMissing
 ・ Optional と Object は要注意
 ・ エラー値の渡る可能性のある引数は ・・・
 ・ #VALUE を返すユーザー定義関数
 ・ セル範囲オブジェクトを引数で受け取る
 ・ シート関数での「オプション引数と IsMissing 」
 Const cstBlue As Long = &HFF0000
 Const cstRed As Long = &H0000FF&
 RGB関数 : RGB( 赤 , 緑 , 青 )
 Const cstBlue As Long = &H0000FF&
 Const cstRed As Long = &HFF0000
 RGB関数 : RGB( 赤 , 緑 , 青 )
   (※ VBA互換モードでは RGB関数を使用するべきではない)
 月末日 = DateSerial ( 年, 月 + 1, 0 )  If ( 月 = 12 ) Then
     月末日 = DateSerial ( 年, 12, 31 )
 Else
     月末日 = DateSerial ( 年, 月 + 1, 1 ) - 1
 End If
 Dim ABC(1 to 5)
 Erase ABC    '静的配列の初期化
 Dim ABC(1 to 5)
 ReDim ABC(1 to 5)    '初期化は同サイズで ReDim
 Empty  Dim cstEmpty As Variant
 '[Empty]値の代替として何も設定せずに利用する
 Sleep (500)
 DoEvents
 Wait (500)
 Replace ( "ABCD", "BC", "xyz" )  Join ( Split ( "ABCD", "BC" ), "xyz" )
 InStr ( "ABCD", "b" )  InStr ( 1, "ABCD", "b", 0 )
 TypeName ( OBJECT )  OBJECT.ImplementationName
 OBJECT1 Is OBJECT2

 OBJECT1 Is Nothing

 EqualUnoObjects ( OBJECT1, OBJECT2 )
 EqualSheetObjects ( SHEET1 , SHEET2 ) [UserFunc]
 OBJECT1  Is  Nothing    (Nothing 比較は可)
 Public
 Public  & [ Option Private Module ]
 Private
 Global   ( Project 外でも有効 )    注) 対象は『変数』のみ
 Public   ( Project 内で有効 )          Sub/Func は全てPublic
 Private  ( Module 内で有効 )          指定してもエラーにはならない
 Result = _
     WorksheetFunctions.XXXX(ARG1, ARG2)
 Dim oFuncService As Object
 oFuncService = _
     CreateUnoService("com.sun.star.sheet.FunctionAccess")

 Dim aArgs(0 to 1) As Variant
 aArgs(0) = ARG1
 aArgs(1) = ARG2
 Result = oFuncService.callFunction("XXXX", aArgs )

    or
 Result = _
     oFuncService.callFunction("XXXX", Array(ARG1, ARG2) )
 【Excel95互換モードでの Match 】
 Dim vntRC As Variant
 vntRC = Application.Match( キー, 検索範囲, 0 )
 If IsError (vntRC) Then  ' #N/A
   ' Not Found
 Else
   MsgBox vntRC  ' 検索位置(1〜)
 End If

 Dim oFuncService As Object
 Dim vntRC As Variant
 oFuncService = _
     CreateUnoService("com.sun.star.sheet.FunctionAccess")
 vntRC = oFuncService.callFunction _
                          ("MATCH", Array( キー, 検索範囲,  0 ) )
 If IsEmpty (vntRC) Then
   ' Not Found
 Else
   MsgBox vntRC  ' 検索位置(1〜)
 End If
 【拡張子に関連付けられたプログラムの実行】
 rc = ShellExecute (0, "Open", URL, vbNullString, _
                vbNullString, SW_SHOWNORMAL)
 oSystemShellExecute = createUnoService _
                      ("com.sun.star.system.SystemShellExecute")
 oSystemShellExecute.execute (URL, "", 0)
 【配列の代入】 ・・・ 配列構造&データのコピー
 Dim vntArray(1 to 3) As Variant
 Dim vntTemp As Variant
 vntTemp = vntArray

 
 【配列の代入】 ・・・ 代入元配列への参照設定
 Dim vntArray(1 to 3) As Variant
 Dim vntTemp As Variant
 vntTemp = vntArray
 ReDim Preserve vntTemp(1 to 3)
 [コピー]にするには、代入後にサイズ変更無しで ReDim Preserve する。
 【ユーザー定義型の代入】 ・・・ データのコピー
 Type UserDef1
   Item1 As String
   Item2 As Integer
 End Type

 Dim ABC As UserDef1
 Dim XYZ As UserDef1
 XYZ  =  ABC
 【ユーザー定義型の代入】 ・・・ 代入元への参照設定

 ユーザー定義型変数同士での代入で[値コピー]とするには、
 関数内の局所変数経由での処理が必要。
 【マウスのボタン判定】
 Private Sub Label1_MouseUp(ByVal Button As Integer, _
           ByVal Shift As Integer, _
           ByVal X As Single, ByVal Y As Single)

 If (Button = 1) Then
   '左ボタン
 Else
   '右ボタン
 End If
【マウスのボタン判定】
 Sub MouseListener_mouseReleased _
                   ( oEvent As com.sun.star.awt.MouseEvent )

 If ( oEvent.Buttons = com.sun.star.awt.MouseButton.LEFT ) Then
   '左ボタン
 Else
   '右ボタン
 End If

 【マウスの Shift , Ctrl , Alt 判定】
 Private Sub Label1_MouseUp(ByVal Button As Integer, _
           ByVal Shift As Integer, _
           ByVal X As Single, ByVal Y As Single)

 Const cstShiftMask As Integer = 1
 Const cstCtrlMask As Integer = 2
 Const cstAltMask As Integer = 4

 blnShift = CBool(Shift And cstShiftMask)
 blnCtrl = CBool(Shift And cstCtrlMask)
 blnAlt = CBool(Shift And cstAltMask)
【マウスの Shift , Ctrl , Alt 判定】
 Sub MouseListener_mouseReleased _
                   ( oEvent As com.sun.star.awt.MouseEvent )

 blnShift = _
     CBool(.Modifiers And com.sun.star.awt.KeyModifier.SHIFT)
 blnCtrl = _
     CBool(.Modifiers And com.sun.star.awt.KeyModifier.MOD1)
 blnAlt = _
     CBool(.Modifiers And com.sun.star.awt.KeyModifier.MOD2)


 【ワークシートのマウスイベント】
 Worksheet_BeforeDoubleClick

 Worksheet_BeforeRightClick
 【シートのマウスイベント】
 XMouseClickHandler               [ Left Single Click ]
 XMouseClickHandler               [ Left Double Click ]

 XEnhancedMouseClickHandler   [ Right + (Shift or Ctrl or Alt) ]
 (右クリックの完全汎用マクロは こちら の記事)
 【セルの変化イベント】
 Worksheet_Change
 【セルの変化イベント】
 XModifyListener
 【Unicode文字の文字コード】
  Asc ("あ") → -32096 , AscW ("あ") → 12354
  Asc ("A") → -32160 , AscW ("A") → -223
  Asc/AscW : Integer 型

 Dim lngUnicode As Long
 lngUnicode = AscW (文字)
 If ( lngUnicode < 0 ) Then
   lngUnicode = lngUnicode + 65536
 End If

 【Unicode文字の文字コード】
  Asc ("あ") → 12354
  Asc ("A") → 65313
  Asc : Long 型

 Dim lngUniCode As Long
 lngUnicode = Asc (文字)




   



[ AddinBox Home へ ]    [ OOo 備忘録へ ]

ロゴ(ゴールド)   ロゴ(ゴールド)

角田 桂一 Mail:addinbox@h4.dion.ne.jp CopyRight(C) 2009 Allrights Reserved.