Macroの杜
(OpenOffice.org/LibreOffice Basic編)


Sub CopyPaste()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' Clipboard へ Copy
		oDispatcher.executeDispatch(oFrame,  ".uno:Copy", "", 0, oProp())
		msgbox "Success"
End Sub

GOGCp-)[General]ClipboardからPaste


Sub CopyPaste()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' Clipboard へ Copy
		oDispatcher.executeDispatch(oFrame,  ".uno:Paste", "", 0, oProp())
		msgbox "Success"
End Sub

GOGCp-)[General]書式設定のCopy / Copy解除


Sub CopyPaste()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' 書式設定のCopy
		oDispatcher.executeDispatch(oFrame,  ".uno:FormatPaintbrush", "", 0, oProp())
		' 書式設定のCopy解除
		oDispatcher.executeDispatch(oFrame,  ".uno:FormatPaintbrush", "", 0, oProp())
End Sub

GOGCp-)[General]Clipboardから形式を選択して貼り付け


Sub CopyPaste()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' Clipboardから形式を選択して貼り付け
			oProp(0).Name = "SelectedFormat"
			oProp(0).Value = 1
		oDispatcher.executeDispatch(oFrame,  ".uno:ClipboardFormatItems", "", 0, oProp())
		msgbox "Success"
End Sub
'
' CalcのCell単位での「 形式を選択して貼り付け 」は Calc編参照

[ Screen ]

GMS-)[General]Screen Lock


Sub ScreenLock()
	Dim oDoc as Object
	Dim oDummy()
	Dim oLockStart 
	Dim oLockEnd
	Dim oUnLockStart 
	Dim oUnLockEnd
	 'Screen Lock(画面更新Lock)
	 oDoc = StarDesktop.loadComponentFromURL( "private:factory/scalc", "_blank", 0, oDummy())
	 oSheet =oDoc.getSheets.getByName("Sheet1")
	 oDoc.addActionLock()
	 	oLockStart = now()
	 		for i = 0 to 1000
	 			oSheet.getCellByPosition(0,i).value = i*100
	 			wait 10
	 		next i
	 	oLockEnd = now()
	 	oLockTime = ((Minute(oLockEnd))*60+Second(oLockEnd)) - ((Minute(oLockStart))*60+Second(oLockStart))	' unit : sec
	'画面更新Lock解除
	oDoc.removeActionLock()
	oDoc.dispose()
	'Screen UnLock
	oDoc = StarDesktop.loadComponentFromURL( "private:factory/scalc", "_blank", 0, oDummy())
	 oSheet =oDoc.getSheets.getByName("Sheet1")
		oUnLockStart = now()
	 		for i = 0 to 1000
	 			oSheet.getCellByPosition(0,i).value = i*100
	 			wait 10
	 		next i
	 	oUnLockEnd = now()
	 	oUnLockTime =  ((Minute(oUnLockEnd))*60+Second(oUnLockEnd)) - ((Minute(oUnLockStart))*60+Second(oUnLockStart))	' unit : sec
	 oDoc.dispose
	 MsgBox("Lock = " & oLockTime & "[ sec ]" & Chr$(10) & _
	 			"UnLock = " & oUnLockTime & "[ sec ]",0,"Compare the Time to Lock with UnLock")
End Sub

GMS-)[General]Screen Lock(2)


Sub DisplaylockContorollers()
	Dim Dummy()
	Dim oDoc As Object
	Dim oSheets As Object
			oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy()) 
		oDoc.lockControllers()
				oSheets = oDoc.getSheets()
				if oDoc.hasControllersLocked() then
					MsgBox("Now, Display Locked")
				End If	
					for i = 0 to 5
						oSheet1 = oDoc.Sheets(0)
						oSheet1.getCellByPosition(0, i).Value = i
						wait 500
					next i
		oDoc.unlockControllers()
End Sub

GMS-)[General]Status Indicator(1)



Sub StatusIndicator()
	Dim oDoc as Object
	Dim oSI as Object
		oDoc = ThisComponent
		oSI = oDoc.CurrentController.StatusIndicator
			oEnd = 100
			'Indicator bar Reset
			oSI.Reset
			oSI.Start("Excuting",oEnd)
 			For i = 0 to 10
 				oSI.setText("Excuting " & 10*i & " / " & oEnd)
 				oSI.setValue(10*i)
 				wait(1000)					' 1 sec
 			next i
		Msgbox("StatusBarをResetします。",0,"StatusBar")
		oSI.Reset
End Sub
'
'[ Note ]
'Not to be shown on BasicIED.
'If you can confirm this macro, you must run the Macro on OOo Document.

GMS-)[General]Status Indicator(2)


Sub oMacroStatusBar
	Dim oDoc
	Dim oStatusBar
		oDoc = ThisComponent
  		oStatusBar = oDoc.getCurrentController().getStatusIndicator()
   		oStatusBar.start("Started", 100)
  			For i = 0 to 9
    			oStatusBar.setValue(i * 10 + 10)
    			wait(300)
  			Next i
		oStatusBar.end()
End Sub

'[ Note ]
'Not to be shown on BasicIED.
'If you can confirm this macro, you must run the Macro on OOo Document.

GMS-)[General]Screen Lock有無確認


Sub ScreenLock()
	Dim oDoc as Object
	Dim oLock1 as Boolean, oLock2 as Boolean
	Dim oDisp as String
		oDoc = ThisComponent
		' Screen Lock
		oDoc.addActionLock()
		oLock1 = oDoc.isActionLocked()
		' Screen Unlock
		oDoc.removeActionLock()
		oLock2 = oDoc.isActionLocked()
		'
		oDisp = "[ Screen Lock ]" & Chr$(10) & "Scees Lock = " & oLock1 & Chr$(10) & "Screen Lock = " & oLock2
		msgbox(oDisp, 0, "Screen Lock")
End Sub

[ Flow Controll Command ]

GMS-)[General]Subrutine内の位置に飛ぶ / SubrutineからExit


Sub oGoSubExitSub
	otest="OpenOffice"
 		GoSub Line1
 			msgbox otest
 		Gosub [Line 2]
 			msgbox otest
 		Exit Sub
 	Line1:
 		otest=otest & ".org"
 		Return
 	[Line 2]:
 		otest=otest & " Macro Test"
 		Return
End Sub

GMS-)[General]Do Loopから抜ける


Sub oExitDo
	Dim a(), i%, x%
		a()=Array(2,4,6,8,10,12,16,18,20,22,24,26,28,30)
		x=Int(32 * Rnd)
		i=LBound(a())
		Do While a(i) <> x
			i =i+1
			If i > UBound(a()) then Exit Do
		Loop
		If i <= UBound(a()) then
			print "Find " + i + " times"
		else
			print "Not Find " + i + " times"
		End If
End Sub

GMS-)[General]入力値から選択


Sub oChoose
	Dim oReturn As String
	Dim oText As String
	Dim i As Integer
	Dim oCh
		oText = InputBox ("1 : Real " & Chr$(10) & _
								"2 : Integer" & Chr$(10) & _
								"3 : Chinese Charactor", _
								"Enter a number (1-3)")
		i = Int(oText)
		oCh = Choose( i, 1.0, 2, "三")
		If IsNull(oCh) Then
			MsgBox("1-3以外の番号が入力されました。"　& Chr$(10) & _
						oText  & "　は不可です。" & Chr$(10) & _
						"終了します。", 0, "Caution!!")
		Else
			MsgBox(oCh & " of type is " & Chr$(10) & TypeName(oCh),0,"Choose Function")
		End If
End Sub

[ Error Handling ]

GME-)[General]Errorを無視/Label行に飛ぶ/Line No.を取得/Error No.を取得/Error Messageの取得


Sub oError
	Line0:
	On Error GoTo 0
	Dim oReturn As String
	Dim oText As String
	Dim i As Integer
	Dim oCh
		oText = InputBox ("1 :  Show the Error Message" & Chr$(10) & _
								"2 :  Ingore the Errors" , "Error Handling")
		i = Int(oText)
		Select case i
			case = 1
				On Error Goto oBad
				oE=1/CInt(0.2)
			case = 2
				On Error Resume Next
				oE=1/CInt(0.2)
				GoSub oBad2
			case else
				MsgBox("1-2以外の番号が入力されました。"　& Chr$(10) & _
						oText  & "　は不可です。" & Chr$(10) & _
						"終了します。", 0, "Caution!!")
		End Select
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
		Exit Sub
	oBad2:
		MsgBox("Errorは全て無視されました。",0,"Caution!!")
		Return
End Sub

OOo Document

GDCmp-)[General]Document構成Folder/File(Writer/Calc/Impress)



Sub DocumentStorage()
	Dim oDoc as Object, oDoc2 as Object
	Dim Dummy() as new com.sun.star.beans.PropertyValue
	Dim oDocStrge as Object, oDocStrge2 as Object
	Dim oFirstComp() as String, oFirstComp2() as String
	Dim oApp as String, oAppName as String
	Dim oName as String, oUrl as String
	Dim oDisp as String
		oDisp = "Docemntの構成Folder & File(非圧縮は除く)" & Chr(10)
		for k = 0 to 2
			select case k
				case 0
					oAppName = "writer"
					oApp = "private:factory/s" & oAppName
					oName = "c:\temp\LibreOfficeMacro.odt"
				case 1
					oAppName = "calc"
					oApp = "private:factory/s" & oAppName
					oName = "c:\temp\MacroCalc.ods"
				case 2
					oAppName = "impress"
					oApp = "private:factory/s" & oAppName
					oName = "c:\temp\OOoMacroImpress.odp"
			end select
			'
			oDoc = StarDesktop.loadComponentFromURL(oApp, "_blank", 0, Dummy())
			oDocStrge = oDoc.getDocumentStorage()
			oFirstComp = oDocStrge.getElementNames()
			'
			oDisp = oDisp & Chr$(10) &"[ New Document ]( " & oAppName & ")" & Chr$(10)
			for i = 0 to UBound(oFirstComp)
				oDisp = oDisp & oFirstComp(i) & Chr$(10)
			next i
			If HasUnoInterfaces(oDoc,"com.sun.star.util.XCloseable") then
				oDoc.close(true)
			End If
			'
			oUrl = ConvertToUrl(oName)
			oDoc2 = StarDesktop.loadComponentFromURL(oUrl, "_blank", 0, Dummy())
			oDocStrge2 = oDoc2.getDocumentStorage()
			oFirstComp2 = oDocStrge2.getElementNames()
			oDisp = oDisp & "[ Existed Document ]" & Chr$(10)
			for i = 0 to UBound(oFirstComp2)
				oDisp = oDisp & oFirstComp2(i) & Chr$(10)
			next i
			If HasUnoInterfaces(oDoc2,"com.sun.star.util.XCloseable") then
				oDoc2.close(true)
			End If
		next k
		' Display
		msgbox oDisp,0,"Document Component"
End Sub

GDCmp-)[General]Document構成Folder/File(Draw/Math/Base)



Sub DocumentStorage()
	Dim oDoc as Object, oDoc2 as Object
	Dim Dummy() as new com.sun.star.beans.PropertyValue
	Dim oDocStrge as Object, oDocStrge2 as Object
	Dim oFirstComp() as String, oFirstComp2() as String
	Dim oApp as String, oAppName as String
	Dim oName as String, oUrl as String
	Dim oDisp as String
		oDisp = "Docemntの構成Folder & File(非圧縮は除く)" & Chr(10)
		for k = 0 to 2
			select case k
				case 0
					oAppName = "draw"
					oApp = "private:factory/s" & oAppName
					oName = "c:\temp\DrawMacro.odg"
				case 1
					oAppName = "math"
					oApp = "private:factory/s" & oAppName
					oName = "c:\temp\MathMacro.odf"
				case 2
					oAppName = "database"
					oApp = "private:factory/s" & oAppName
					oName = "c:\temp\oBaseMacroTest.odb"
			end select
			'
			oDoc = StarDesktop.loadComponentFromURL(oApp, "_blank", 0, Dummy())
			oDocStrge = oDoc.getDocumentStorage()
			oFirstComp = oDocStrge.getElementNames()
			'
			oDisp = oDisp & Chr$(10) &"[ New Document ]( " & oAppName & ")" & Chr$(10)
			for i = 0 to UBound(oFirstComp)
				oDisp = oDisp & oFirstComp(i) & Chr$(10)
			next i
			If HasUnoInterfaces(oDoc,"com.sun.star.util.XCloseable") then
				oDoc.close(true)
			End If
			'
			oUrl = ConvertToUrl(oName)
			oDoc2 = StarDesktop.loadComponentFromURL(oUrl, "_blank", 0, Dummy())
			oDocStrge2 = oDoc2.getDocumentStorage()
			oFirstComp2 = oDocStrge2.getElementNames()
			oDisp = oDisp & "[ Existed Document ]" & Chr$(10)
			for i = 0 to UBound(oFirstComp2)
				oDisp = oDisp & oFirstComp2(i) & Chr$(10)
			next i
			If HasUnoInterfaces(oDoc2,"com.sun.star.util.XCloseable") then
				oDoc2.close(true)
			End If
		next k
		' Display
		msgbox oDisp,0,"Document Component"
End Sub

GDCmp-)[General]

[ Condition ]

GDC-)[General]Document状態[ ReadOnly ]の確認(com.sun.star.frame.XStorable)


Sub oXStorable2
	Dim oDoc
		oDoc = ThisComponent
			oReadonly = oDoc.isReadonly		'Readonly Fileかどうかの判定
			print oReadonly		
End Sub

GDC-)[General]Document状態[ 保護 ]の確認


Sub oIsProtectXStorable
	Dim oDoc
		oDoc = ThisComponent
			oProtect = oDoc.isProtected
		msgbox(oProtect,0,"IsProtect of ThisComponent")
End Sub

GDC-)[General]Document状態[ 変更されたかどうか ]の確認


Sub oIsModifiedXStorable()
	Dim oDoc as Object
	Dim oModify1 as Boolean, oModify2 as Boolean
	Dim oDisp as String
		oDoc = ThisComponent
		oModify1 = oDoc.isModified
		'
		' 変更Statusの変更
		if oModify1 then
			oDoc.setModified( false )
		else
			oDoc.setModified( true )
		end if
		oModify2 = oDoc.isModified
		'
		oDisp = "[ isModified ]" & Chr$(10) & "Before = " & oModify1 & Chr$(10) & "After = " & oModify2
		msgbox(oDisp,0,"IsModified of ThisComponent")
End Sub
'
' [ Note ]
' IsModify値 は setModified( true or false ) で変更できる事に注意。

GDC-)[General]Document状態[ ControllerLockされているか ]の確認


Sub oLock
	Dim oDoc
		oDoc = ThisComponent
			oLock = oDoc.hasControllersLocked
			msgbox(oLock,0,"hasControllersLocked of ThisComponent")
End Sub

[ Load ]

GDL-)[General]Templateとして起動



Sub oLoadTemplate()
	Dim oArgs(2) As New com.sun.star.beans.PropertyValue 
	Dim oDoc
		oFileName = "c:\temp\oDocPara.ods" 
		oURL = ConvertToUrl(oFileName)
			oArgs(0).Name="AsTemplate"
			oArgs(0).Value= true
			oArgs(1).Name="TemplateName"
			oArgs(1).Value = "oCalc_template"
			oArgs(2).Name="TemplateRegionName"
			oArgs(2).Value= "oCalcTemplateRegion"
		oDoc = StarDesktop.LoadComponentFromUrl(oURL, "_blank", 0, oArgs())
	Dim oGArgs
	Dim oDocArgs$ as String
	Dim i%
		On Error Resume Next
			oGArgs = oDoc.getArgs()
			for i = 0 to UBound(oGArgs)
				oDocArgs = oDocArgs & oGArgs(i).Name & " = "
				oDocArgs = oDocArgs & oGArgs(i).Value
				oDocArgs = oDocArgs & Chr$(10)
			next i
		msgbox(oDocArgs, 0, "AsTemplate")
	oDOc.dispose
End Sub

GDL-)[General]画面に表示せずに起動


Sub oLoadHidden
	Dim oArgs(0) As New com.sun.star.beans.PropertyValue 
	Dim oDoc
		oFileName = "c:\temp\oDocPara.ods" 
		oURL = ConvertToUrl(oFileName)
			oArgs(0).Name="Hidden"
			oArgs(0).Value= true
		oDoc = StarDesktop.LoadComponentFromUrl(oURL, "_blank", 0, oArgs())
		msgbox("只今Hidden modeにて" & Chr$(10) & oFileName　&Chr$(10) & "を起動中です",0,"Hidden Mode")
		oDoc.dispose
End Sub

GDL-)[General]新規Viewにて起動せず



Sub oLoadNewView()
	Dim oArgs(0) As New com.sun.star.beans.PropertyValue 
	Dim oDoc
		oFileName = "c:\temp\oDocPara.ods" 
		oURL = ConvertToUrl(oFileName)
			oArgs(0).Name="OpenNewView"
			oArgs(0).Value= false
		oDoc = StarDesktop.LoadComponentFromUrl(oURL, "_blank", 0, oArgs())
	Dim oDocArgs$ as String
	Dim oGArgs
	Dim i%
		On Error Resume Next
			oGArgs = oDoc.getArgs()
			for i = 0 to UBound(oGArgs)
				oDocArgs = oDocArgs & oGArgs(i).Name & " = "
				oDocArgs = oDocArgs & oGArgs(i).Value
				oDocArgs = oDocArgs & Chr$(10)
			next i		
		msgbox(oDocArgs, 0, "Property Args of ThisCompoment")
		oDOc.dispose
End Sub

GDL-)[General]Preview Modeにて起動



Sub oLoadPreView
	Dim oArgs(0) As New com.sun.star.beans.PropertyValue 
	Dim oDoc
		oFileName = "c:\temp\oDocPara.ods" 
		oURL = ConvertToUrl(oFileName)
			oArgs(0).Name="Preview"
			oArgs(0).Value= true
		oDoc = StarDesktop.LoadComponentFromUrl(oURL, "_blank", 0, oArgs())
End Sub

GDL-)[General]ReadOnlyとして起動



Sub oLoadReadOnly()
	Dim oArgs(0) As New com.sun.star.beans.PropertyValue 
	Dim oDoc
		oFileName = "c:\temp\oDocPara.ods" 
		oURL = ConvertToUrl(oFileName)
			oArgs(0).Name="ReadOnly"
			oArgs(0).Value= true
		oDoc = StarDesktop.LoadComponentFromUrl(oURL, "_blank", 0, oArgs())
End Sub

GDL-)[General]Macroの実行不許可


Sub oLoadMacroExcutionMode
	Dim oArgs(0) As New com.sun.star.beans.PropertyValue 
	Dim oDoc
		oFileName = "c:\temp\oDocPara.ods" 
		oURL = ConvertToUrl(oFileName)
			oArgs(0).Name="MacroExcutionMode"
			oArgs(0).Value= com.sun.star.document.MacroExecMode.NEVER_EXECUTE
		oDoc = StarDesktop.LoadComponentFromUrl(oURL, "_blank", 0, oArgs())
End Sub

GDL-)[General]CSV Fileを読み込み


Sub oCalcOpen_CSV()
	Dim oCSV(1) As New com.sun.star.beans.PropertyValue
		oName = "c:\OOo_Macro.csv"
		oUrl = ConvertToURL(oName)
		oCSV(0).Name = "FilterName"
		oCSV(0).Value = "scalc: Text - txt - csv (StarCalc)"
		oCSV(1).Name = "FilterOptions"
		oCSV(1).Value = "44/32,34,0,1,1/2/2/3/2/4/2"
	oDoc = StarDesktop.loadComponentFromURL(oUrl, "_blank", 0, oCSV())
End Sub
'
[ Note ] : ASCII Value,Text Portion,CharactorSet(Default:0),1(Field_Num)/Format/2/Format/･･･/10/Format
[ ASCII_Value ]
44	:	Comma(,)
32	:	Space
9	:	Tab
[ Format ]
1	:	Standard
2	:	Text
3	:	MM/DD/YY
4	:	DD/MM/YY
5	:	YY/MM/DD
9	:	Do not Import
10	:	Format in the US-English locale regardless of the current locale.

GDL-)[General]DialogからFile選択


Sub Main
	fName = FileOpenDialog ("ファイルを選択してください")
		oName=ConvertFromUrl(fName)
		msgbox("選択したファイルは" & Chr$(10) & Chr$(9) & oName & _
					Chr$(10) & "ですね",0,"選択したファイル名: ")
End Sub
'[ Function1 ]
Function FileOpenDialog(title as String) as String
	filepicker = createUnoService("com.sun.star.ui.dialogs.FilePicker")
	filepicker. Title = title
	filepicker.execute()
	files = filepicker.getFiles()
	FileOpenDialog=files(0)
End function

[ Store ]

GDS-)[General]PDF Fileに出力


Sub oPdfExport
Dim oDoc As Object
Dim Dummy()
Dim args(0) As new com.sun.star.beans.PropertyValue
	oDoc = ThisComponent
	oIdent = oDoc.Identifier
		Select Case oIdent
			Case "com.sun.star.text.TextDocument"
				'Confirm
				If oDoc.SupportsService(oIdent) then
					args(0).Name="FilterName"
					args(0).Value="writer_pdf_Export"
				End If	
			Case "com.sun.star.sheet.SpreadsheetDocument"
				If oDoc.SupportsService(oIdent) then
					args(0).Name="FilterName"
					args(0).Value="calc_pdf_Export"
				End If	
			Case "com.sun.star.presentation.PresentationDocument"
				If oDoc.SupportsService(oIdent) then
					args(0).Name="FilterName"
					args(0).Value="impress_pdf_Export"
				End If
			Case "com.sun.star.drawing.DrawingDocument"
				If oDoc.SupportsService(oIdent) then
					args(0).Name="FilterName"
					args(0).Value="draw_pdf_Export"
				End If
			Case "com.sun.star.formula.FormulaProperties"
				If oDoc.SupportsService(oIdent) then
					args(0).Name="FilterName"
					args(0).Value="math_pdf_Export"
				End If
			Case Else
				MsgBox("Can't Expoet as PDF !!", 0, "Caution")
				Exit Sub
		End Select
		oFileName = "C:\temp\OOo_Macro.pdf"
		oFileURL = ConvertToUrl(oFileName)
		oDoc.storeToURL( oFileURL,args())
End Sub

GDS-)[General]Optionを付けてPDF出力


Sub oPdfExportwithOption
	Dim oDoc As Object
	Dim Dummy()
	Dim args(1) As new com.sun.star.beans.PropertyValue
	Dim oFDArg(5) As New com.sun.star.beans.PropertyValue
 		oDoc = ThisComponent
		args(0).Name="FilterName"
		args(0).Value="writer_pdf_Export"
		args(1).Name = "FilterData"
			oFDArg(0).Name = "RestrictPermissions"
 			oFDArg(0).Value = True
 			oFDArg(1).Name = "PermissionPassword"
 			oFDArg(1).Value = "pass"
 			oFDArg(2).Name = "Changes"
 			oFDArg(2).Value = 0
 			oFDArg(3).Name = "EncryptFile"
 			oFDArg(3).Value = True
 			oFDArg(4).Name = "DocumentOpenPassword"
 			oFDArg(4).Value = "pass"
 			oFDArg(5).Name = "EnableCopyingOfContent"
 			oFDArg(5).Value = False
		args(1).Value = oFDArg
		oFileName = "C:\temp\OOo_Macro.pdf"
		oFileURL = ConvertToUrl(oFileName)
		oDoc.storeToURL( oFileURL,args())
End Sub

GDS-)[General]Hbrid PDF作成


Sub oPdfExportwithOption
	Dim oDoc As Object
	Dim Dummy()
	Dim args(1) As new com.sun.star.beans.PropertyValue
	Dim oFDArg(0) As New com.sun.star.beans.PropertyValue
 		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
 		oSheet = oDoc.getSheets().getByIndex(0)
 		oSheet.getCellByPosition(0,0).String = "Hbrid Pdf"
 		oSheet.getCellByPosition(0,2).Value = 10
 		oSheet.getCellByPosition(0,3).Value = 20
 		oSheet.getCellByPosition(0,4).Formula = "=A3*A4"
 		'
		args(0).Name="FilterName"
		args(0).Value="calc_pdf_Export"
		args(1).Name = "FilterData"
			oFDArg(0).Name = "IsAddStream"
			oFDArg(0).Value = True
		args(1).Value = oFDArg
		oFileName = "C:\temp\OOo_Macrohybrid.pdf"
		oFileURL = ConvertToUrl(oFileName)
		oDoc.storeToURL( oFileURL,args())
		oDoc.dispose
		'
		Dim oPdfDoc
			oPdfDoc = StarDesktop.loadComponentFromURL(oFileURL, "_blank", 0, Dummy())
			msgbox "Success"
			oPdfDoc.dispose
End Sub

GDS-)[General]上書き保存


Sub oOverwrite
	Dim oDoc
	Dim oArgs(0) As new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oArgs(0).Name = "Overwrite"
		oArgs(0).Value = true
		oFileName = "c:\temp\oDocPara.ods"
		oFileURL = ConvertToUrl(oFileName)
		oDoc.storeToURL( oFileURL,oArgs())
End Sub

GDS-)[General]


Sub oPassword
	Dim oDoc
	Dim oArgs(0) As new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oArgs(0).Name = "Password"
		oArgs(0).Value = "pass"
		oFileName = "c:\temp\oDocPara.ods"
		oFileURL = ConvertToUrl(oFileName)
		oDoc.storeToURL( oFileURL,oArgs())
End Sub

GDS-)[General]Templateとして保存


Sub oStoreTemplate
	Dim oArgs(2) As New com.sun.star.beans.PropertyValue 
	Dim oDoc
		oFileName = "c:\temp\oDocPara.ods" 
		oURL = ConvertToUrl(oFileName)
			oArgs(0).Name="AsTemplate"
			oArgs(0).Value= true
			oArgs(1).Name="TemplateName"
			oArgs(1).Value = "oCalc_template"
			oArgs(2).Name="TemplateRegionName"
			oArgs(2).Value= "oCalcTemplateRegion"
		oDoc = ThisComponent
		oDoc.StoreAsUrl(oURL,oArgs())
End Sub

GDS-)[General]画像dataを圧縮せずに保存


Sub oUnpacked
	Dim oDoc
	Dim oArgs(0) As new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oArgs(0).Name = "Unpacked"
		oArgs(0).Value = true
		oFileName = "c:\temp\oDocPara.ods"
		oFileURL = ConvertToUrl(oFileName)
		oDoc.storeToURL( oFileURL,oArgs())
End Sub

GDS-)[General]Documentの強制終了


Sub oXCloseable()
	'Safety Close
	Dim oDoc as Object
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy()) 
		If HasUNOInterfaces(oDoc,"com.sun.star.util.XColseable") then
			oDoc.close(true)
		Else
			oDoc.dispose()	' ← 強制終了
		End If
End Sub

GDS-)[General]Documentの安全なClose


Sub oSafeClose()
Dim oDoc As Object
	oDoc = StarDesktop.getFrames()
	Rem oDoc = ThisComponent 
	If HasUnoInterfaces(oDoc,"com.sun.star.util.XCloseable") then
		oDoc.close(true)
	End If
End Sub

GFS-)[General]Store可能形式取得



Sub oDocTransferDataFlavor()
	Dim oDoc
	Dim OOo
	Dim SufOOo
	Dim oTempName
	Dim oDummy()
	Dim oStoreFile(0)  As New com.sun.star.beans.PropertyValue
	Dim oProp
		oProp = "TransferDataFlavors"
		' Initialize Display
			oDisp = "<< " & oProp & " >>" & Chr$(10) 
			for n= 0 to 5
				Select case n
					case = 0
						OOo = "writer"
						SufOOo = "odt"
					case = 1
						OOo = "calc"
						SufOOo = "ods"
					case = 2
						OOo = "draw"
						SufOOo = "odg"
					case = 3
						OOo = "impress"
						SufOOo = "odp"
					case = 4
						OOo = "math"
						SufOOo = "odf"
					case = 5
						OOo = "database"
						SufOOo = "odb"
				End Select
				oDoc = StarDesktop.loadComponentFromURL("private:factory/s" & OOo , "_blank", 0, oDummy())
				oTempName = ConvertToUrl("c:\temp\oDocProp." & SufOOo)
				oStoreFile(0).Name = "Overwrite"
				oStoreFile(0).Value = true
				oDoc.storeAsURL(oTempName,oStoreFile())
			'Properties [ Array ]
				Dim oArray
				Dim i%
		On Error Resume Next
			oDisp = oDisp & "[  " & OOo & "  ]" & Chr$(10)
			oArray = oDoc.TransferDataFlavors
			for i = 0 to UBound(oArray)
				oDisp = oDisp & i+1 & " ) " & "MimeType = " & oArray(i).MimeType
				oDisp = oDisp & Chr$(10)
				oDisp = oDisp & "       " & "HumanPresentableName = "& oArray(i).HumanPresentableName
				oDisp = oDisp & Chr$(10)
			next i
			oDisp = oDisp & Chr$(10)
			oDoc.close(true)
				If n > 5 then Exit Sub
			
		If oDisp = "<< " & oProp & " >>" & Chr$(10) & "   " then
			oDisp = oDisp & Chr$(10) & "  に関する情報はありません"
		End If
		msgbox(oDisp, 0, oProp & " of Properties" )
		oDisp = ""	
		next n					
End Sub

GDS-)[General]fileがDisk内に既保存の判定と既保存時のfile名取得(com.sun.star.frame.XStorable)


Sub oXStorable1
	Dim oDoc
		oDoc = ThisComponent
			ohas = oDoc.hasLocation()			'Disk内に既に保存されているかの判定
			oget = oDoc.getLocation()			'保存されているfileName取得
			print ohas
			print ConvertFromUrl(oget)
End Sub

GDS-)[General]file保存(上書き保存)(com.sun.star.frame.XStorable)


Sub oXStorable3
	Dim oDoc
	Dim Args(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
			'Store
				oDoc.store()
End Sub

GDS-)[General]名前を付けて保存(編集fileは新しいfile(macro1(writer).odt)になる)(com.sun.star.frame.XStorable)


Sub oXStorable
	Dim oDoc
	Dim Args(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
			'Store
				ostoreName1 = ConvertToUrl("c:\temp\macro1(writer).odt")
				ostoreName2 = ConvertToUrl("c:\temp\macro2(writer).odt")
				Args(0).Name = "Overwrite"
				Args(0).Value = true
					oDoc.storeAsUrl(ostoreName1, Args())
End Sub

GDS-)[General]名前を付けて保存(編集fileは現在編集中のfileのまま)(com.sun.star.frame.XStorable)


Sub oXStorable
	Dim oDoc
	Dim Args(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
			'Store
				ostoreName1 = ConvertToUrl("c:\temp\macro1(writer).odt")
				ostoreName2 = ConvertToUrl("c:\temp\macro2(writer).odt")
				Args(0).Name = "Overwrite"
				Args(0).Value = true
					oDoc.storeToUrl(ostoreName2, Args())
End Sub

GDS-)[General]MS-Office2003形式で保存(com.sun.star.frame.XStorable)


Sub oXStorableMSformat()
	Dim oDoc as Object
	Dim Args(1) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
			'Store
				ostoreName2 = ConvertToUrl("c:\temp\macro2(writer).doc")
				Args(0).Name = "Overwrite"
				Args(0).Value = False
				Args(1).Name = "FilterName"
				Args(1).Value = "MS Word 97"
					oDoc.storeToUrl(ostoreName2, Args())	
End Sub

GDS-)[General]文書の保存確認Dialogの表示(変更がある場合)



Sub DocStore()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oCtrl.suspend( true )
End Sub

[ Selection ]

GDSel-)[General]現在のFrameをActivate(1)


Sub oGetCurrentController()
	Dim oDoc as Object
	Dim oController As Object 
	Dim oFrame As Object 
		oDoc = ThisComponent
		oController = oDoc.getCurrentController()
		oFrame = oController.getFrame()
		oFrame.Activate()
		'
		msgbox("Suucess")  
End Sub

GDSel-)[General]現在のFrameをActivate(2)) / 最前Windowにする


Sub oGetCurrentController()
	Dim oDoc as Object
	Dim oController As Object 
	Dim oFrame As Object 
		oDoc = ThisComponent
		oController = oDoc.getCurrentController()
		oFrame = oController.getFrame()
		oFrame.getContainerWindow().toFront()
		'
		msgbox("Suucess")  
End Sub

GDSel-)[General]Selection Areaを数える


Sub oGetCurrentSelection()
	Dim oDoc as Object
	Dim oSel as Object
	Dim oSelCnt as Long
	Dim oDisp as String
		oDoc = ThisComponent
		oSel = oDoc.getCurrentSelection()
		'
		Select Case oDoc.Identifier
			Case "com.sun.star.text.TextDocument"
				if oSel.supportsService("com.sun.star.text.TextRanges") then
					oSelCnt = oSel.getCount()
					oDisp = "There are " & Chr$(10) & Chr$(9) & _
							oSelCnt & " selections" & Chr$(10) & " in the current Writer document."
				else
					oDisp = "Selection is Nothing( Writer )"
    			end if
			Case "com.sun.star.sheet.SpreadsheetDocument"
				if oSel.supportsService("com.sun.star.sheet.SheetCellRanges") then
					oSelCnt = oSel.getCount()
					oDisp = "There are " & Chr$(10) & Chr$(9) & _
							oSelCnt & " selections" & Chr$(10) & " in the current Calc document."
				else
					oDisp = "Selection is Nothing( Calc )"
    			end if
			Case Else
				oDisp = "Writer or Calc Documentではありません。"
				msgbox(oDisp,0,"Caution")
				Exit Sub
		End Select
		'
		msgbox(oDisp, 0, "Current Selction")
End Sub

GDSel-)[General]全て選択


Sub WriterCalcAllSel()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch(oFrame,  ".uno:SelectAll", "", 0, oProp())
		'
		msgbox "Success",0,"Select All"
End Sub

GDSelMd-)[General]Default( Writer )



Sub WriterSelectMode()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch(oFrame,  ".uno:SelectionModeDefault", "", 0, oProp())
		'
		msgbox "Success",0,"Select Mode"
End Sub

GDSelMd-)[General]Block選択( Writer )



Sub WriterSelectMode()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch(oFrame,  ".uno:SelectionModeBlock", "", 0, oProp())
		'
		msgbox "Success",0,"Select Mode"
End Sub

GDSelMd-)[General]次の選択Modeへ変更[ 拡張、拡張 ]( Writer )



Sub WriterSelectMode()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' 標準 → 拡張
		oDispatcher.executeDispatch(oFrame,  ".uno:SelectionMode", "", 0, oProp())
		' 拡張 → 追加
		oDispatcher.executeDispatch(oFrame,  ".uno:SelectionMode", "", 0, oProp())
		msgbox "Success",0,"Select Mode"
End Sub
'
' [ Note ]
' 最初に
' oDispatcher.executeDispatch(oFrame,  ".uno:SelectionModeDefault", "", 0, oProp())
' や
' oDispatcher.executeDispatch(oFrame,  ".uno:SelectionModeBLock", "", 0, oProp())
' を実行すると、標準、Blockから変更しない模様

GDSelMd-)[General]Default選択( Calc )



Sub CalcSelectMode()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch(oFrame,  ".uno:StatusSelectionModeNorm", "", 0, oProp())
		msgbox "Success",0,"Select Mode"
End Sub

GDSelMd-)[General]拡張選択( Calc )



Sub CalcSelectMode()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch(oFrame,  ".uno:StatusSelectionModeExt", "", 0, oProp())
		msgbox "Success",0,"Select Mode"
End Sub

GDSelMd-)[General]追加選択( Calc )



Sub CalcSelectMode()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch(oFrame,  ".uno:StatusSelectionModeExp", "", 0, oProp())
		msgbox "Success",0,"Select Mode"
End Sub

GDSelMd-)[General]

[ XUndoManagerSupplier / XUndoManager ]

GDUdMg-)[General]直前の編集を元に戻す(1)



Sub UndoMng()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' 事前準備
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i * i
		next i
		' Undo
		oDispatcher.executeDispatch(oFrame,  ".uno:Undo", "", 0, oProp())		' A6 Cellの入力取消
		oDispatcher.executeDispatch(oFrame,  ".uno:Undo", "", 0, oProp())		' A5 Cellの入力取消
		msgbox "Success"
End Sub

GDUdMg-)[General]直前の編集を元に戻す(2)



Sub UndoMng()
	Dim oDoc as Object
	Dim oUndoMgr as Object
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oUndoMgr = oDoc.getUndoManager()
		' 事前準備
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i
		next i
		' Undo
		if oUndoMgr.isUndoPossible then
			oUndoMgr.undo()		' A6 Cellの入力を取消
		end if
		if oUndoMgr.isUndoPossible then
			oUndoMgr.undo()		' A5 Cellの入力を取消
		end if
		msgbox "Success"
End Sub

GDUdMg-)[General]直前の編集をやり直す(1)



Sub UndoMng()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' 事前準備
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i * i
		next i
		' Undo / Redo
		oDispatcher.executeDispatch(oFrame,  ".uno:Undo", "", 0, oProp())		' A6 Cellの入力取消
		oDispatcher.executeDispatch(oFrame,  ".uno:Redo", "", 0, oProp())		' A6 Cellに再度入力
		msgbox "Success"
End Sub
'
' [ Note ]
' Undo は 直前の操作を取り消す
' Redo は Undo で取り消した操作を再度やり直す

GDUdMg-)[General]直前の編集をやり直す(2)



Sub UndoMng()
	Dim oDoc as Object
	Dim oUndoMgr as Object
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oUndoMgr = oDoc.getUndoManager()
		' 事前準備
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i
		next i
		' Undo / Redo
		if oUndoMgr.isUndoPossible() then
			oUndoMgr.undo()		' A6 Cellの入力を取消
		end if
		if oUndoMgr.isRedoPossible() then
			oUndoMgr.redo()		' A6 Cellに再度入力
		end if	
		msgbox "Success"
End Sub

GDUdMg-)[General]直前の編集を繰り返し



Sub UndoMng()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' 事前準備
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A2"
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
			oProp(0).Name = "StringName"
			oProp(0).Value = "LibreOffice"
		oDispatcher.executeDispatch(oFrame,  ".uno:EnterString", "", 0, oProp())
			oProp(0).Name = "By"		' Writerでは 無意味
			oProp(0).Value = 3
		oDispatcher.executeDispatch(oFrame,  ".uno:GoDown", "", 0, oProp())
		' Repeat
		oDispatcher.executeDispatch(oFrame,  ".uno:Repeat", "", 0, Array())
		msgbox "Success"
End Sub

GDUdMg-)[General]任意の編集( UndoContext )を元に戻す



Sub UndoMng()
	Dim oDoc as Object
	Dim oUndoMgr as Object
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.getCellByPosition(0, 0).String = "LibreOffice"
		oSheet.getCellByPosition(0, 2).String = "Apache OpenOffice"
		'
		oUndoMgr = oDoc.getUndoManager()
		' UndoContext作成開始
		oUndoMgr.enterUndoContext("UndoCxt01")
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i
		next i
		' UndoContext 終了
		oUndoMgr.leaveUndoContext()
		'
		' UndoContext作成後に処理を行うとその処理がTop Stuck Actionになり、最後の処理がoUndoMgr.undo()対象になる
		Rem oSheet.getCellByPosition(1, 2).String = "Test"
		Rem oSheet.getCellByPosition(1, 3).String = "Test2"
		'
		' 作成した UndoContext実行
		if oUndoMgr.isUndoPossible = true then
			oUndoMgr.undo()
			oDisp = "Success"
		else
			oDisp = "実行可能Undoがありません。"	
		end if
		msgbox oDisp,0,"UndoManager"
End Sub

GDUdMg-)[General]任意の編集( UndoContext )をやり直す



Sub UndoMng()
	Dim oDoc as Object
	Dim oUndoMgr as Object
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.getCellByPosition(0, 0).String = "LibreOffice"
		oSheet.getCellByPosition(0, 2).String = "Apache OpenOffice"
		'
		oUndoMgr = oDoc.getUndoManager()
		' UndoContext作成開始
		oUndoMgr.enterUndoContext("UndoCxt01")
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i
		next i
		' UndoContext 終了
		oUndoMgr.leaveUndoContext()
		'
		' 作成した UndoContext実行
		if oUndoMgr.isUndoPossible() then
			oUndoMgr.undo()
			oDisp = "Undoを実行しました"
		else
			oDisp = "実行可能Undoがありません。"	
		end if
		msgbox oDisp,0,"UndoManager"
		'
		if oUndoMgr.isRedoPossible() then
			oUndoMgr.redo()
			oDisp = "Redoを実行しました"
		else
			oDisp = "実行可能Redoがありません。"
		end if
		msgbox oDisp,0,"UndoManager"
End Sub

GDUdMg-)[General]Current UndoのTitle取得



Sub UndoMng()
	Dim oDoc as Object
	Dim oUndoMgr as Object
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.getCellByPosition(0, 0).String = "LibreOffice"
		oSheet.getCellByPosition(0, 2).String = "Apache OpenOffice"
		'
		oUndoMgr = oDoc.getUndoManager()
		' UndoContext作成開始
		oUndoMgr.enterUndoContext("UndoCxt01")
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i
		next i
		' UndoContext 終了
		oUndoMgr.leaveUndoContext()
		'
	Dim oUndoCtxTitle as String
		if oUndoMgr.isUndoPossible then
			oUndoCtxTitle = oUndoMgr.getCurrentUndoActionTitle()
			oDisp = "[ Curent UndoContext ]" & Chr$(10) & " Undo = " & oUndoCtxTitle
		else
			oDisp = "実行可能Undoがありません。"	
		end if
		'
		msgbox oDisp,0,"UndoManager"
End Sub

GDUdMg-)[General]Current RedoのTitle取得



Sub UndoMng()
	Dim oDoc as Object
	Dim oUndoMgr as Object
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.getCellByPosition(0, 0).String = "LibreOffice"
		oSheet.getCellByPosition(0, 2).String = "Apache OpenOffice"
		'
		oUndoMgr = oDoc.getUndoManager()
		' UndoContext作成開始
		oUndoMgr.enterUndoContext("UndoCxt01")
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i
		next i
		' UndoContext 終了
		oUndoMgr.leaveUndoContext()
		'
	Dim oRedoCtxTitle as String
		if oUndoMgr.isUndoPossible then
			oUndoMgr.undo()
			if oUndoMgr.isRedoPossible then
				oRedoCtxTitle = oUndoMgr.getCurrentRedoActionTitle()
				oDisp = "[ Curent UndoContext ]" & Chr$(10) & " Redo = " & oRedoCtxTitle
			else
				oDisp = "実行可能Redoがありません。"
			end if
		else
			oDisp = "実行可能Undoがありません。"	
		end if
		'
		msgbox oDisp,0,"UndoManager"
End Sub

GDUdMg-)[General]全てのUndo Title取得



Sub UndoMngOr()
	Dim oDoc as Object
	Dim oUndoMgr as Object
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.getCellByPosition(0, 0).String = "LibreOffice"		' 入力
		oSheet.getCellByPosition(0, 2).String = "Apache OpenOffice"	' 入力
		'
		oUndoMgr = oDoc.getUndoManager()
		' UndoContext作成開始
		oUndoMgr.enterUndoContext("UndoCxt01")
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i
		next i
		' UndoContext 終了
		oUndoMgr.leaveUndoContext()
		'
		' UndoContext作成開始
		oUndoMgr.enterUndoContext("UndoCxt02")
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(1, i )
			oCell.Value = i * i * i
		next i
		' UndoContext 終了
		oUndoMgr.leaveUndoContext()
		'
	Dim oUndoCtxAll() as String
		if oUndoMgr.isUndoPossible then
			oUndoCtxAll = oUndoMgr.getAllUndoActionTitles()
			oDisp = "[ UndoContext / Title ]" & Chr$(10)
			for i = 0 to UBound(oUndoCtxAll)
				oDisp = oDisp & i & ") " & oUndoCtxAll(i) & Chr$(10)
			next i
			' Top Level Undo
			oDisp = oDisp & Chr$(10) & "[ Title of top-most Action  ]" & Chr$(10) & oUndoMgr.getCurrentUndoActionTitle()
		else
			oDisp = "実行可能Undoがありません。"	
		end if
		'
		msgbox oDisp,0,"UndoManager"
End Sub

GDUdMg-)[General]全てのRedo Title取得



Sub UndoMngOr()
	Dim oDoc as Object
	Dim oUndoMgr as Object
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.getCellByPosition(0, 0).String = "LibreOffice"		' 入力
		oSheet.getCellByPosition(0, 2).String = "Apache OpenOffice"	' 入力
		'
		oUndoMgr = oDoc.getUndoManager()
		' UndoContext作成開始
		oUndoMgr.enterUndoContext("UndoCxt01")
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i
		next i
		' UndoContext 終了
		oUndoMgr.leaveUndoContext()
		'
		' UndoContext作成開始
		oUndoMgr.enterUndoContext("UndoCxt02")
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(1, i )
			oCell.Value = i * i * i
		next i
		' UndoContext 終了
		oUndoMgr.leaveUndoContext()
		'
	Dim oRedoCtxAll() as String
	Dim nn as Integer
		if oUndoMgr.isUndoPossible then
			nn = 0
			Do While oUndoMgr.isUndoPossible and nn < 100
				oUndoMgr.undo()
				nn = nn + 1
			Loop
			'
			oRedoCtxAll = oUndoMgr.getAllRedoActionTitles()
			for i = 0 to UBound(oRedoCtxAll)
				oDisp = oDisp & i & ") " & oRedoCtxAll(i) & Chr$(10)
			next i
			' Top Level Redo
			oDisp = oDisp & Chr$(10) & "[ Title of top-most Action  ]" & Chr$(10) & oUndoMgr.getCurrentRedoActionTitle()
		else
			oDisp = "実行可能Undoがありません。"	
		end if
		'
		msgbox oDisp,0,"UndoManager"
End Sub

GDUdMg-)[General]Undo / RedoのClear



Sub UndoMng()
	Dim oDoc as Object
	Dim oUndoMgr as Object
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.getCellByPosition(0, 0).String = "LibreOffice"
		oSheet.getCellByPosition(0, 2).String = "Apache OpenOffice"
		'
		oUndoMgr = oDoc.getUndoManager()
		' UndoContext作成開始
		oUndoMgr.enterUndoContext("UndoCxt01")
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i
		next i
		' UndoContext 終了
		oUndoMgr.leaveUndoContext()
		'
		' 作成した UndoContext実行
		if oUndoMgr.isUndoPossible() then
			oUndoMgr.undo()
			oDisp = "Undoを実行しました"
		else
			oDisp = "実行可能Undoがありません。"	
		end if
		'
		' Undo / RedoのClear
		oUndoMgr.clear()
		'
		if oUndoMgr.isRedoPossible() then
			oUndoMgr.redo()
			oDisp = oDisp & Chr$(10) & "Redoを実行しました"
		else
			oDisp = oDisp & Chr$(10) &  "実行可能Redoがありません。"
		end if
		'
		if oUndoMgr.isUndoPossible() then
			oUndoMgr.undo()
			oDisp = oDisp & Chr$(10) & "Undoを実行しました"
		else
			oDisp = oDisp & Chr$(10) &  "実行可能Undoがありません。"
		end if
		msgbox oDisp,0,"UndoManager"
End Sub

GDUdMg-)[General]RedoのみClear



Sub UndoMng()
	Dim oDoc as Object
	Dim oUndoMgr as Object
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.getCellByPosition(0, 0).String = "LibreOffice"
		oSheet.getCellByPosition(0, 2).String = "Apache OpenOffice"
		'
		oUndoMgr = oDoc.getUndoManager()
		' UndoContext作成開始
		oUndoMgr.enterUndoContext("UndoCxt01")
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i
		next i
		' UndoContext 終了
		oUndoMgr.leaveUndoContext()
		'
		' 作成した UndoContext実行
		if oUndoMgr.isUndoPossible() then
			oUndoMgr.undo()
			oDisp = "Undoを実行しました"
		else
			oDisp = "実行可能Undoがありません。"	
		end if
		'
		' RedoのみClear
		oUndoMgr.clearRedo()
		'
		if oUndoMgr.isRedoPossible() then
			oUndoMgr.redo()
			oDisp = oDisp & Chr$(10) & "Redoを実行しました"
		else
			oDisp = oDisp & Chr$(10) &  "実行可能Redoがありません。"
		end if
		'
		if oUndoMgr.isUndoPossible() then
			oUndoMgr.undo()
			oDisp = oDisp & Chr$(10) & "Undoを実行しました"
		else
			oDisp = oDisp & Chr$(10) &  "実行可能Undoがありません。"
		end if
		msgbox oDisp,0,"UndoManager"
End Sub

GDUdMg-)[General]UndoManagerのLock/Unlock(未完成)



Sub UndoMngOr()
	Dim oDoc as Object
	Dim oUndoMgr as Object
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.getCellByPosition(0, 0).String = "LibreOffice"		' 入力
		oSheet.getCellByPosition(0, 2).String = "Apache OpenOffice"	' 入力
		'
		oUndoMgr = oDoc.getUndoManager()
	'	oUndoMgr.reset()
	'	Exit Sub
		oDisp = "[ UndoContext / Title ]" & Chr$(10)
		'
		' Lock
		oUndoMgr.lock()		' ← lock出来ない？
		if NOT oUndoMgr.isLocked then
			' UndoContext作成開始
			oUndoMgr.enterUndoContext("UndoCxt01")
			for i = 0 to 5
				oCell = oSheet.getCellByPosition(0, i )
				oCell.Value = i * i
			next i
			' UndoContext 終了
			oUndoMgr.leaveUndoContext()
			'
			oDisp = oDisp & "UndoContextを追加しました(1)" & Chr$(10)
		else
			oDisp = oDisp & "Lockされています(1)" & Chr$(10)
		end if
		'
		' UndoManagerのUnLock
		oUndoMgr.lock()
		'
		if NOT oUndoMgr.isLocked then
			' UndoContext作成開始
			oUndoMgr.enterUndoContext("UndoCxt02")
			for i = 0 to 5
				oCell = oSheet.getCellByPosition(1, i )
				oCell.Value = i * i * i
			next i
			' UndoContext 終了
			oUndoMgr.leaveUndoContext()
			oDisp = oDisp & "UndoContextを追加しました(2)" & Chr$(10)
		else
			oDisp = oDisp & "Lockされています(2)" & Chr$(10)
		end if'
		
		'
	Dim oUndoCtxAll() as String
		if oUndoMgr.isUndoPossible then
			oUndoCtxAll = oUndoMgr.getAllUndoActionTitles()
			for i = 0 to UBound(oUndoCtxAll)
				oDisp = oDisp & i & ") " & oUndoCtxAll(i) & Chr$(10)
			next i
			' Top Level Undo
			oDisp = oDisp & Chr$(10) & "[ Title of top-most Action  ]" & Chr$(10) & oUndoMgr.getCurrentUndoActionTitle()
		else
			oDisp = "実行可能Undoがありません。"	
		end if
		'
		msgbox oDisp,0,"UndoManager"
End Sub

GDUdMg-)[General]UndoManagerのReset



Sub UndoMng()
	Dim oDoc as Object
	Dim oUndoMgr as Object
	Dim oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.getCellByPosition(0, 0).String = "LibreOffice"
		oSheet.getCellByPosition(0, 2).String = "Apache OpenOffice"
		'
		oUndoMgr = oDoc.getUndoManager()
		' UndoContext作成開始
		oUndoMgr.enterUndoContext("UndoCxt01")
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0, i )
			oCell.Value = i * i
		next i
		' UndoContext 終了
		oUndoMgr.leaveUndoContext()
		'
		' 作成した UndoContext実行
		if oUndoMgr.isUndoPossible() then
			oUndoMgr.undo()
			oDisp = "Undoを実行しました"
		else
			oDisp = "実行可能Undoがありません。"	
		end if
		'
		' Reset
		oUndoMgr.reset()
		'
		if oUndoMgr.isRedoPossible() then
			oUndoMgr.redo()
			oDisp = oDisp & Chr$(10) & "Redoを実行しました"
		else
			oDisp = oDisp & Chr$(10) &  "実行可能Redoがありません。( Reset )"
		end if
		'
		if oUndoMgr.isUndoPossible() then
			oUndoMgr.undo()
			oDisp = oDisp & Chr$(10) & "Undoを実行しました"
		else
			oDisp = oDisp & Chr$(10) &  "実行可能Undoがありません。( Reset )"
		end if
		msgbox oDisp,0,"UndoManager"
End Sub
'
' [ Note ]
' clear() は Undo / Redo が初期化
' reset() は clear() に加えて、Lockも初期化

GDUdMg-)[General]

Window

GW-1)[General]Window Sizeを設定する


Sub Main
	Dim oController As Object
	Dim oFrame As Object
	Dim oContainerWindow As Object
		oDoc = ThisComponent
		oController = oDoc.getCurrentController()
		oFrame = oController.getFrame()
		oContainerWindow = oFrame.getContainerWindow()
		'
		oContainerWindow.setPosSize( 0, 0, 1024, 768, 12 )
End Sub

GW-1a)[General]Window Sizeを設定する2


Sub Main
	Dim oController As Object
	Dim oFrame As Object
	Dim oContainerWindow As Object
	Dim aSize As New com.sun.star.awt.Size
		oDoc = ThisComponent
		oController = oDoc.getCurrentController()
		oFrame = oController.getFrame()
		oContainerWindow = oFrame.getContainerWindow()
		'
		aSize.Width = 800 : aSize.Height = 700
		oContainerWindow.setOutputSize(aSize)
End Sub

GW-2)[General]Windowの最小化


Sub MinWindow
   dim frame
   dim window
   dim handle
  
    frame  = StarDesktop.getActiveFrame()
    window = frame.getContainerWindow()
    handle = window.getWindowHandle(dimarray(), 1) ' 1=WIN32
    'msgbox handle
    ShowWindow( handle, 2 )
  
End Sub

GW-3)[General]Windowの最大化


Sub MaxWindow
	dim frame
	dim window
	dim handle  
		frame  = StarDesktop.getActiveFrame()
    	window = frame.getContainerWindow()
    	handle = window.getWindowHandle(dimarray(), 1) ' 1=WIN32
    '	msgbox handle
    	ShowWindow( handle, 3 )  
End Sub

GW-4)[General]WindowのFull Screen表示


Sub subFullScreen
   oDoc = ThisComponent
   oDocCtrl = oDoc.getCurrentController()
   oDocFrame = oDocCtrl.getFrame()
  
   cDispatchUrl = ".uno:FullScreen"
  
   oDispatchHelper = createUnoService( "com.sun.star.frame.DispatchHelper" )
   oDispatchHelper.executeDispatch( oDocFrame, cDispatchUrl, "", 0, Array() )
End Sub

GW-)[General]画面Zoomの設定


Sub WindowZoom()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
    Dim oProp(2) as new com.sun.star.beans.PropertyValue
    	oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    	' Zoom 設定
    		oProp(0).Name = "Zoom.Value"
    		oProp(0).Value = 75						' Zoom.Type が 0( 任意 )の時のみ設定。それ以外は  -32768
    		oProp(1).Name = "Zoom.ValueSet"
    		oProp(1).Value = 28703
    		oProp(2).Name = "Zoom.Type"
    		oProp(2).Value = 0   				' 0 : 任意 / 1 : 最適 / 2 : Page全体 / 3 : Page幅
    	oDispatcher.executeDispatch(oFrame, ".uno:Zoom", "", 0, oProp())
    	'
    msgbox "Success"
End Sub
'
' [ Note ]
' 1) 100% は　" Zoom.Type " を 0 で "Zoom.Value" を 100 にする。
' 2) Calcでは別の方法もある。
' 3) Calc以外では .ZoomType / .ZoomValue Propertiesが無い

GW-6)[General]Windowsを任意サイズ(75%)にする


Sub oWindowSize
Dim vF
Dim vW
Dim vRect As New com.sun.star.awt.Rectangle
	vF = StarDesktop.getCurrentFrame()
	vW = vF.getContainerWindow()
	vRect = vW.getPosSize()
	oPer=3/4	'75%
	vW.setPosSize(vRect.X, vRect.Y, oPer*vRect.Width, oPer*vRect.Height, com.sun.star.awt.PosSize.SIZE)
End Sub

GW-)[General]CurrentFrame Title所得


Sub oFrameTitle
	oTitle = StarDesktop.getactiveFrame().Title
	msgbox oTitle
End Sub

GW-)[General]Desktop上に起動しているOOo関連の全てのFrame数を取得


Sub oDisplayFrameCount
	Dim oAllFrame As Variant
	Dim oCount As Integer
	Dim i As Integer
	Dim s As String
		'Get all of the frames
		oAllFrame = StarDesktop.getFrames
		oCount = oAllFrame.getCount()
		msgbox oCount
End Sub

GW-)[General]Desktop上に起動しているOOo関連の全てのFrame名を取得


Sub oDisplayFrame
	Dim oAllFrame As Variant
	Dim oFrame As Variant
	Dim oCount As Integer
	Dim i As Integer
	Dim oScreen As String
		'Get all of the frames
		oAllFrame = StarDesktop.getFrames
		oCount = oAllFrame.getCount()
		for i =0 to oCount-1
			oFrame = oAllFrame.getByIndex(i)
			oScreen = oScreen & " : " & oFrame.title & chr$(10)
		next
			msgbox(oScreen,0,"Frame Title")
End Sub

GW-)[General]Frameの検索


Sub oDisplayFrame
Dim oAllFrame As Variant
Dim i As Integer
Dim oScreen As String
	'SearchFlag
	oFSFC1 = com.sun.star.frame.FrameSearchFlag.AUTO
	oFSFC2 = com.sun.star.frame.FrameSearchFlag.PARENT
	oFSFC3 = com.sun.star.frame.FrameSearchFlag.SELF
	oFSFC4 = com.sun.star.frame.FrameSearchFlag.CHILDREN
	oFSFC5 = com.sun.star.frame.FrameSearchFlag.CREATE
	oFSFC6 = com.sun.star.frame.FrameSearchFlag.SIBLINGS
	oFSFC7 = com.sun.star.frame.FrameSearchFlag.TASKS
	oFSFC8 = com.sun.star.frame.FrameSearchFlag.ALL
	oFSFC9 = com.sun.star.frame.FrameSearchFlag.GLOBAL
	msgbox("AUTO : " & oFSFC1 & "(Use 6 = SELF+CHILDREN)" & chr$(10) _
				& "PARENT : " & oFSFC2 & chr$(10) _
				& "SELF : " & oFSFC3 & chr$(10) _
				& "CHILDREN : " & oFSFC4 & chr$(10) _
				& "CREATE : " & oFSFC5 & chr$(10) _
				& "SIBLINGS : " & oFSFC6 & chr$(10) _
				& "TASKS : " & oFSFC7 & chr$(10) _
				& "ALL : " & oFSFC8 & chr$(10) _
				& "GLOBAL : " & oFSFC9)
	'Search frames
	oAllFrame = StarDesktop.getFrames().queryFrames(31)
	for i =LBound(oAllFrame) to UBound(oAllFrame)
		oScreen = oScreen & oAllFrame(i).title & chr$(10)
	next
	msgbox(oScreen,0,"Frame Title")
End Sub

[ Note ] : 31 = 23 + 8 = ALL + CREATE

GW-)[General]同名FrameがOpen済かどうか検索確認後、新規fileをOpenする


Sub oUseAnExistingFrame
Dim Dummy()
Dim oDoc As Object
Dim oSrh As Long
Dim oFName As String
	oSrh = 63 'com.sun.star.frame.FrameSearchFlag.GLOBAL + com.sun.star.frame.FrameSearchFlag.CREATE
	oURL = "private:factory/swriter"
	oFName = "TestFrame"
	vFrame = ThisComponent.CurrentController.Frame
	oDoc = vFrame.LoadComponentFromUrl(oURL, oFName, oSrh, Dummy()) 
	If IsNull(oDoc) then
		Print "Failed to create a document"
		Exit Sub
	End If
End Sub

[ Property ]

GWPUrl-)[General]URL取得(1a)



Sub oDocURL
	Dim oDoc
	Dim OOo
	Dim SufOOo
	Dim oTempName
	Dim oDummy()
	Dim oArray(0)  As New com.sun.star.beans.PropertyValue
	Dim oProp
		oProp = "URL"
		' Initialize Display
			oDisp = "<< " & oProp & " >>" & Chr$(10) & "   "
			for n= 0 to 5
				Select case n
					case = 0
						OOo = "writer"
						SufOOo = "odt"
					case = 1
						OOo = "calc"
						SufOOo = "ods"
					case = 2
						OOo = "draw"
						SufOOo = "odg"
					case = 3
						OOo = "impress"
						SufOOo = "odp"
					case = 4
						OOo = "math"
						SufOOo = "odf"
					case = 5
						OOo = "database"
						SufOOo = "odb"
				End Select
				oDoc = StarDesktop.loadComponentFromURL("private:factory/s" & OOo , "_blank", 0, oDummy())
				oTempName = ConvertToUrl("c:\temp\oDocProp." & SufOOo)
				oArray(0).Name = "Overwrite"
				oArray(0).Value = true
				oDoc.storeAsURL(oTempName,oArray())
			'Properties [ String ]
				oS= oDoc.URL
					If NOT IsEmpty(oS) and NOT IsNull(oS) and oS<>"" then
						oFileName = ConvertFromURL(oS)
						oDisp = oDisp & "[  " & OOo & "  ] =  "& oFileName & Chr$(10) & "   "
					End If
				oDoc.close(true)
				If n > 5 then Exit Sub
			next n
		If oDisp = "<< " & oProp & " >>" & Chr$(10) & "   " then
			oDisp = oDisp & Chr$(10) & "  に関する情報はありません"
		End If
		msgbox(oDisp, 0, oProp & " of PropertiesString" )						
End Sub

GWPUrl-)[General]URL取得(1b)



Sub oDocURL
	Dim oDoc
	Dim oDocURL
	Dim oDocGetURL
		oDoc = ThisComponent
		oDocURL = oDoc.URL
		oDocGetURL = oDoc.getURL()
	msgbox("URL" & Chr$(9) & " => " & oDocURL & Chr$(10) & _
			"getURL" & Chr$(9) & " => " & oDocGetURL,0,"URL of ThisComponent")
End Sub

GWPUrl-)[General]URL取得(その2)



Sub oDocLocation
	Dim oDoc
	Dim OOo
	Dim SufOOo
	Dim oTempName
	Dim oDummy()
	Dim oArray(0)  As New com.sun.star.beans.PropertyValue
	Dim oProp
		oProp = "Location"
		' Initialize Display
			oDisp = "<< " & oProp & " >>" & Chr$(10) & "   "
			for n= 0 to 5
				Select case n
					case = 0
						OOo = "writer"
						SufOOo = "odt"
					case = 1
						OOo = "calc"
						SufOOo = "ods"
					case = 2
						OOo = "draw"
						SufOOo = "odg"
					case = 3
						OOo = "impress"
						SufOOo = "odp"
					case = 4
						OOo = "math"
						SufOOo = "odf"
					case = 5
						OOo = "database"
						SufOOo = "odb"
				End Select
				oDoc = StarDesktop.loadComponentFromURL("private:factory/s" & OOo , "_blank", 0, oDummy())
				oTempName = ConvertToUrl("c:\temp\oDocProp." & SufOOo)
				oArray(0).Name = "Overwrite"
				oArray(0).Value = true
				oDoc.storeAsURL(oTempName,oArray())
			'Properties [ String ]
				oS= oDoc.Location
					If NOT IsEmpty(oS) and NOT IsNull(oS) and oS<>"" then
						oFileName = ConvertFromURL(oS)
						oDisp = oDisp & "[  " & OOo & "  ] =  "& oFileName & Chr$(10) & "   "
					End If
				oDoc.close(true)
				If n > 5 then Exit Sub
			next n
		If oDisp = "<< " & oProp & " >>" & Chr$(10) & "   " then
			oDisp = oDisp & Chr$(10) & "  に関する情報はありません"
		End If
		msgbox(oDisp, 0, oProp & " of PropertiesString" )						
End Sub

GWPUrl-)[General]URL取得(2b)



Sub oDocLocation
	Dim oDoc
	Dim oDocURL
	Dim oDocGetURL
		oDoc = ThisComponent
		oDocURL = oDoc.Location
		oDocGetURL = oDoc.getLocation()
	msgbox("Location" & Chr$(9) & " => " & oDocURL & Chr$(10) & _
			"getLocation" & Chr$(9) & " => " & oDocGetURL,0,"URL( Location ) of ThisComponent")
End Sub

GWPt-)[General]Title取得(1)



Sub oTitle1
	Dim oDoc
	Dim oURL
		'Library(Tools)を使用
			GlobalScope.BasicLibraries.LoadLibrary("Tools")
				oDoc = ThisComponent
				oURL = oDoc.getLocation()
				oTitle = FileNameOutOfPath(oUrl)
			MsgBox(oTitle,0,"File Title ( Used ""BasicLibraries"" )")			
End Sub

GDPt-)[General]Title取得(2)



Sub oDocTitle
	Dim oDoc
	Dim OOo
	Dim SufOOo
	Dim oTempName
	Dim oDummy()
	Dim oArray(0)  As New com.sun.star.beans.PropertyValue
	Dim oProp
		oProp = "Title"
		' Initialize Display
			oDisp = "<< " & oProp & " >>" & Chr$(10) & "   "
			for n= 0 to 5
				Select case n
					case = 0
						OOo = "writer"
						SufOOo = "odt"
					case = 1
						OOo = "calc"
						SufOOo = "ods"
					case = 2
						OOo = "draw"
						SufOOo = "odg"
					case = 3
						OOo = "impress"
						SufOOo = "odp"
					case = 4
						OOo = "math"
						SufOOo = "odf"
					case = 5
						OOo = "database"
						SufOOo = "odb"
				End Select
				oDoc = StarDesktop.loadComponentFromURL("private:factory/s" & OOo , "_blank", 0, oDummy())
				oTempName = ConvertToUrl("c:\temp\oDocProp." & SufOOo)
				oArray(0).Name = "Overwrite"
				oArray(0).Value = true
				oDoc.storeAsURL(oTempName,oArray())
			'Properties [ String ]
				oS= oDoc.Title
					If NOT IsEmpty(oS) and NOT IsNull(oS) and oS<>"" then
						oDisp = oDisp & "[  " & OOo & "  ] =  "& ConvertFromURL(oS) & Chr$(10) & "   "
					End If
				oDoc.close(true)
				If n > 5 then Exit Sub
			next n
		If oDisp = "<< " & oProp & " >>" & Chr$(10) & "   " then
			oDisp = oDisp & Chr$(10) & "  に関する情報はありません"
		End If
		msgbox(oDisp, 0, oProp & " of PropertiesString" )						
End Sub

GDPt-)[General]Title取得(2b)



Sub oCurCompTitle
	Dim oComp
	Dim oCurCompTitle
		oComp = StarDesktop.getCurrentComponent()
		oCurCompTitle = oComp.getTitle()
		If oCurCompTitle <> "無題 1" then
			MsgBox("[ Current Component ]" & Chr$(10) & "   Title : " & oCurCompTitle, 0, "Title of Current Component")
		else
			MsgBox("[ Current Component ]" & Chr$(10) & "   Basic IDE ", 0, "Title of Current Component")
		End If
End Sub

GDPt-)[General]Title取得(3a)



Sub FileTitle()
	Dim oFile as String, oURL as String
	Dim oFileTitle as String
	Dim oDisp as String
		GlobalScope.BasicLibraries.LoadLibrary("Tools")
		oFile = "c:\temp\oTextMacro.txt"
		oURL = ConvertToUrl(oFile)
		oFileTitle = FileNameoutofPath(oURL, "/")
		oDisp = "[ Use global library ]" & Chr$(10) & ConvertFromUrl(oFileTitle)
	msgbox( oDisp, 0, "File Title")
End Sub

GDPt-)[General]Title取得(3b)



Sub FileDirPath()
	Dim oFile as String, oURL as String
	Dim oFileTitle as String
	Dim oDisp as String
		oFile = "c:\temp\oTextMacro.txt"
		oURL = ConvertToUrl(oFile)
		oFileTitle = FileNameoutofPath(oURL, "/")
		oDisp = "[ Not use global library ]" & Chr$(10) & oFileTitle
	msgbox( oDisp, 0, "File Title")
End Sub
'
'
' [ 共通Function ]
Function ArrayoutofString( oBigString as String, oSeparator as String, Optional oMaxIndex as Integer )
	Dim oLocList() as String
		oLocList = split( oBigString, oSeparator )
		If NOT IsMissing(oMaxIndex) then
			oMaxIndex = UBound(oLocList)
		End If
		ArrayoutofString = oLocList
End Function
'
Function FileNameoutofPath( ByVal oPath as String, Optional oSeparator as String ) as String
	Dim i as Integer
	Dim oSepList() as String
		If IsMissing(oSeparator) then
			oPath = ConvertFromUrl(oPath)
			oSeparator = GetPathSeparator()
		End If
		oSepList() = ArrayoutofString( oPath, oSeparator, i )
		FileNameoutofPath = oSepList(i)
End Function

GDPt-)[General]All Opened Title取得得



Sub oEnumerateComponentNames
	Dim oComp As Object
	Dim oEnumerate As Object
	Dim oD As String
		GlobalScope.BasicLibraries.LoadLibrary("Tools")	
			oComp=StarDesktop.getComponents() 'com.sun.star.container.XEnumerationAccess
			If NOT oComp.hasElements() then
				Print "There are no components"
				Exit Sub
			End If
			oEnumerate = oComp.createEnumeration() 'com.sun.star.container.XEnumeration
			Do  while oEnumerate.hasMoreElements()
				oComp = oEnumerate.nextElement()
				If HasUnoInterfaces(oComp, "com.sun.star.frame.XModel") and oComp.getURL() <> ""  then
					oD = oD & FileNameOutOfPath(oComp.getURL()) & chr$(10)
				End If
			Loop
		Msgbox(oD, 0, "Document Names")
End Sub

GDPi-)[General]OOo Applicetion Identitfy(Less Base)



Sub oDocIdentifier
	Dim oDoc
	Dim OOo
	Dim SufOOo
	Dim oTempName
	Dim oDummy()
	Dim oArray(0)  As New com.sun.star.beans.PropertyValue
	Dim oProp
		oProp = "Identifier"
		' Initialize Display
			oDisp = "<< " & oProp & " >>" & Chr$(10) & "   "
			for n= 0 to 5
				Select case n
					case = 0
						OOo = "writer"
						SufOOo = "odt"
					case = 1
						OOo = "calc"
						SufOOo = "ods"
					case = 2
						OOo = "draw"
						SufOOo = "odg"
					case = 3
						OOo = "impress"
						SufOOo = "odp"
					case = 4
						OOo = "math"
						SufOOo = "odf"
				End Select
				oDoc = StarDesktop.loadComponentFromURL("private:factory/s" & OOo , "_blank", 0, oDummy())
				oTempName = ConvertToUrl("c:\temp\oDocProp." & SufOOo)
				oArray(0).Name = "Overwrite"
				oArray(0).Value = true
				oDoc.storeAsURL(oTempName,oArray())
			'Properties [ String ]
				oS= oDoc.Identifier
					If NOT IsEmpty(oS) and NOT IsNull(oS) and oS<>"" then
						oDisp = oDisp & "[  " & OOo & "  ] =  "& oS & Chr$(10) & "   "
					End If
				oDoc.close(true)
				If n > 5 then Exit Sub
			next n
		If oDisp = "<< " & oProp & " >>" & Chr$(10) & "   " then
			oDisp = oDisp & Chr$(10) & "  に関する情報はありません"
		End If
		msgbox(oDisp, 0, oProp & " of PropertiesString" )						
End Sub

GDPi-)[General]OOo Applicetion Identitfy(1)



Sub oDocImplementationName
	Dim oDoc
	Dim OOo
	Dim SufOOo
	Dim oTempName
	Dim oDummy()
	Dim oArray(0)  As New com.sun.star.beans.PropertyValue
	Dim oProp
		oProp = "ImplementationName"
		' Initialize Display
			oDisp = "<< " & oProp & " >>" & Chr$(10) & "   "
			for n= 0 to 5
				Select case n
					case = 0
						OOo = "writer"
						SufOOo = "odt"
					case = 1
						OOo = "calc"
						SufOOo = "ods"
					case = 2
						OOo = "draw"
						SufOOo = "odg"
					case = 3
						OOo = "impress"
						SufOOo = "odp"
					case = 4
						OOo = "math"
						SufOOo = "odf"
					case = 5
						OOo = "database"
						SufOOo = "odb"
				End Select
				oDoc = StarDesktop.loadComponentFromURL("private:factory/s" & OOo , "_blank", 0, oDummy())
				oTempName = ConvertToUrl("c:\temp\oDocProp." & SufOOo)
				oArray(0).Name = "Overwrite"
				oArray(0).Value = true
				oDoc.storeAsURL(oTempName,oArray())
			'Properties [ String ]
				oS= oDoc.ImplementationName
					If NOT IsEmpty(oS) and NOT IsNull(oS) and oS<>"" then
						oDisp = oDisp & "[  " & OOo & "  ] =  "& oS & Chr$(10) & "   "
					End If
				oDoc.close(true)
				If n > 5 then Exit Sub
			next n
		If oDisp = "<< " & oProp & " >>" & Chr$(10) & "   " then
			oDisp = oDisp & Chr$(10) & "  に関する情報はありません"
		End If
		msgbox(oDisp, 0, oProp & " of PropertiesString" )						
End Sub

GB-)[General]OOo Applicetion Identitfy(2)



Sub oObjImplementationName
	Dim oDoc
	Dim OOo
	Dim oDummy()
		for i= 0 to 5
			Select case i
				case = 0
					OOo = "writer"
				case = 1
					OOo = "calc"
				case = 2
					OOo = "draw"
				case = 3
					OOo = "impress"
				case = 4
					OOo = "math"
				case = 5
					OOo = "database"
			End Select
			oDoc = StarDesktop.loadComponentFromURL("private:factory/s" & OOo , "_blank", 0, oDummy())
			'Implementation Name
				Dim oObjImpName(5) as String
				Dim oDisp
					oObjImpName(i) = oDoc.getImplementationName()
					oDisp = oDisp & "[ " & OOo & " ]" & Chr$(10) & "     " & oObjImpName(i) & Chr$(10)
			oDoc.close(true)
		next i
		MsgBox(oDisp, 0, "Implementation Name for Objects")
End Sub

GDPi-)[General]OpenOffice.orgのVersion取得(1)



Sub OOoVersion1
	Dim OOoVer as String
		OOoVer = GetSolarVersion
	MsgBox("The version of this LibreOffice is " & Chr$(10) & Chr$(9) & Chr$(9) & _
			 "ver. " & OOoVer, 0, "LibreOffice Version")
End Sub

GDPi-)[General]OpenOffice.orgのVersion取得(2)



Sub OOoVersion2
	Dim oSet, oConfigProvider
	Dim oParm(0) As New com.sun.star.beans.PropertyValue
	Dim oProvider$, oAccess$
	Dim OOoVer As String
		oProvider = "com.sun.star.configuration.ConfigurationProvider"
		oAccess   = "com.sun.star.configuration.ConfigurationAccess"
		oConfigProvider = createUnoService(oProvider)
		oParm(0).Name = "nodepath"
		oParm(0).Value = "/org.openoffice.Setup/Product"
		oSet = oConfigProvider.createInstanceWithArguments(oAccess, oParm())
		OOoVer = oSet.getByName("ooSetupVersion")
	MsgBox("The version of this LibreOffice  is " & Chr$(10) & Chr$(9) & Chr$(9) & _
			 "ver. " & OOoVer, 0, "LibreOffice Version")
End Sub

･Document Properties

[ Document Property ]

GDp-)[General]Document Property Information



Sub DocumentInfoSrv()
	Dim oUnoSrvObj as Object
	Dim oPropertyName() as String
		oUnoSrvObj = CreateUnoService("com.sun.star.document.DocumentProperties")
		oPropertyName = split(oUnoSrvObj.dbg_properties,";")
		oDisp = "[  Item of Document Property Information ] " & Chr$(10)
		n = 1
		for i = 0 to UBound(oPropertyName)
			oName = Right(  oPropertyName(i), _
				Len(oPropertyName(i)) - InStr(5, oPropertyName(i), " "))
			if Left(oName, 1) = Chr$(10) then
				oName = Right(oName, Len(oName)-1)
			end if
			if InStr(1, oName, "dbg_") = 0 and InStr(1, oName, ".") = 0 and _
				InStr(1, oName, "Supported") = 0 and oName <> "Modified" and _
				oName <> "Types" and oName <>"ImplementationId" and _
				oName <>"UserDefinedProperties" then
				'
				oDisp = oDisp & n & ") " & oName & CHr$(10)
				n = n + 1
			end if
		next i
		msgbox oDisp,0,"DocumentProperties Service"
End Sub

GDp-)[General]Document Property Information( Old )



' Old Code
Sub oDocumentInfoName()
	Dim oDoc as Object
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oInfo as Object
	Dim oProp() as Object
	Dim oVal
	Dim i%
	Dim sInfo$ As String
	Dim oCount%
		On Error Goto oBad 
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, oDummy())
		'Parameter to be stored
			oStore(0).Name = "Overwite"
			oStore(0).Value = true	
			sName = "c:\temp\oAuthor.ods"
			sURL = ConvertAsUrl(sName)
		'Store
			oDoc.storeAsUrl(sURL, oStore())
		'Get Name of the Document Infomation 
			oInfo = oDoc.getPropertyInfo()		' ← Service com.sun.star.document.DocumentInfo は廃止
			oProp = oInfo.getPropertyValues()
			oDisp = "[  Item of Document Property Information ] " & Chr$(10)
			for i = 0 to UBound(oProp)
				oDisp = oDisp & i+1 & ") " & Chr$(9) & oProp(i).Name
				oDisp = oDisp & Chr$(10)
			next i
			msgbox(oDisp, 0, " Item of Property Information ")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
			Kill(sURL) 
End Sub
'
' [ Caution ]
' com.suns.star.document.DocumentInfo Service は LO4.0で削除された。( http://www.mail-archive.com/libreoffice-bugs@lists.freedesktop.org/msg70271.html )
' Apache OpenOffice3.4 では Site( http://www.openoffice.org/api/docs/common/ref/com/sun/star/document/DocumentInfo.html )
'が残っているが、実際にはSupportされていない。
' Discription にも "Use DocumentProperties instead." と記されている。
' Service com.sun.srat.document.DocumentProperties 
' 
' 上記記Codeが実際に動作する可能性があるのは、LotusSymphony3.0 だと思います。

GDp-)[General]作成者と更新者



Sub ogetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad 
		oDoc=StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, oDummy())
		Wait(10)
		'Parameter to be stored
			sName = "c:\temp\oAuthor.ods"
			sURL = ConvertToUrl(sName)
		'New Store
			oStore(0).Name="Overwrite"
			oStore(0).Value=true
			oDoc.storeAsUrl(sURL, oStore())
		'Store after Midified
			Wait(5000)
				Randomize 2^14-1
				oDoc.Sheets(0).getCellByPosition(0,0).value=Int((100 * Rnd) ) 		'0 から 100 の整数値を生成
					oStore(0).Name="Overwrite"
					oStore(0).Value=true
					oDoc.storeAsUrl(sURL, oStore())
		'Get Name of the Document Infomation 
			'Author
				aprop = oDoc.getDocumentProperties().Author		'<= 作成者
					oDisp = oDisp & " [ Author ] " & Chr$(10)
					oDisp = oDisp & Chr$(9) & aprop　
			'ModifiedBy				
				mprop = oDoc.getDocumentProperties().ModifiedBy		'<= 変更者
					oDisp = oDisp & Chr$(10)
					oDisp = oDisp & " [ ModifiedBy ] " & Chr$(10)
					oDisp = oDisp & Chr$(9) & mprop
			'Display
				msgbox(oDisp, 0, " [ Author / ModifiedBy ]  ")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
			Kill(sURL) 
End Sub

GDp-)[General]作成日と更新日



Sub ogetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad 
		oDoc=StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, oDummy())
		Wait(10)
		'Parameter to be stored
			sName = "c:\temp\oAuthor.ods"
			sURL = ConvertToUrl(sName)
		'New Store
			oStore(0).Name="Overwrite"
			oStore(0).Value=true
			oDoc.storeAsUrl(sURL, oStore())
		'Store after Midified
			Wait(10000)
				Randomize 2^14-1
				oDoc.Sheets(0).getCellByPosition(0,0).value=Int((100 * Rnd) ) 		'0 から 100 の整数値を生成
					oStore(0).Name="Overwrite"
					oStore(0).Value=true
					oDoc.storeAsUrl(sURL, oStore())
		'Get Name of the Document Infomation 
			'CreateDate
				cprop_d = oDoc.getDocumentProperties().CreationDate		'<= 変更無しで保存した日
					cpropy = cprop_d.Year
					cpropm = cprop_d.Month
					cpropd = cprop_d.Day
					cproph = cprop_d.Hours
					cpropmi = cprop_d.Minutes
					cprops = cprop_d.Seconds
				oDisp = oDisp & " [ CreationDate ] " & Chr$(10)
				oDisp = oDisp & Chr$(9) & cpropy & "/" & cpropm & "/" & cpropd & Chr$(10) & _
								Chr$(9) & cproph & ":" & cpropmi & ":" & cprops
			'ModifyDate
				
				mprop_d = oDoc.getDocumentProperties().ModifyDate		'<= 変更して保存した日
					mpropy = mprop_d.Year
					mpropm = mprop_d.Month
					mpropd = mprop_d.Day
					mproph = mprop_d.Hours
					mpropmi = mprop_d.Minutes
					mprops = mprop_d.Seconds
				oDisp = oDisp & Chr$(10)
				oDisp = oDisp & " [ ModifyDate ] " & Chr$(10)
				oDisp = oDisp & Chr$(9) & mpropy & "/" & mpropm & "/" & mpropd & Chr$(10) & _
								Chr$(9) & mproph & ":" & mpropmi & ":" & mprops
				msgbox(oDisp, 0, " [ CreationDate / ModifyDate ]  ")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
			Kill(sURL) 
End Sub

GDp-)[General]最終Print者とPrint日の取得



Sub ogetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad 
		oDoc=StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, oDummy())
		Wait(10)
		'Input Value
			Randomize 2^14-1
			oDoc.Sheets(0).getCellByPosition(0,0).value=Int((100 * Rnd) ) 		'0 から 100 の整数値を生成
		'Parameter to be stored
			sName = "c:\temp\oAuthor.ods"
			sURL = ConvertToUrl(sName)
		'New Store
			oStore(0).Name="Overwrite"
			oStore(0).Value=true
			oDoc.storeAsUrl(sURL, oStore())			
		'Print out
			Dim oProps(1) as new com.sun.star.beans.PropertyValue
				oProps(0).Name = "Pages"
				oProps(0).Value = "0-0"
				oDoc.print(oProps())
			msgbox("Print out",0,"Message")
		'Get Name of the Document Infomation 
			'PrintedBy
				aprop = oDoc.getDocumentProperties().PrintedBy		'<= 最終Print者
					oDisp = oDisp & " [ PrintedBy ] " & Chr$(10)
					oDisp = oDisp & Chr$(9) & aprop　
			'PrintDate		
				cprop_d = oDoc.getDocumentProperties().PrintDate	'<= 変更無しで保存した日
					cpropy = cprop_d.Year
					cpropm = cprop_d.Month
					cpropd = cprop_d.Day
					cproph = cprop_d.Hours
					cpropmi = cprop_d.Minutes
					cprops = cprop_d.Seconds
				oDisp = oDisp & Chr$(10)	
				oDisp = oDisp & " [ PrintDate ] " & Chr$(10)
				oDisp = oDisp & Chr$(9) & cpropy & "/" & cpropm & "/" & cpropd & Chr$(10) & _
								Chr$(9) & cproph & ":" & cpropmi & ":" & cprops
			'Display
				msgbox(oDisp, 0, " [ PrintedBy / PrintDate ]  ")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
			Kill(sURL) 
End Sub

GDp-)[General]自動更新設定状態の取得1



Sub oGetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'get the Property
			oprop = oDoc.getDocumentProperties().AutoloadEnabled
			If oprop = true then
				oALE = "自動更新するに設定されています。!!"
			Else 
				If oprop = false then
					oALE = "自動更新しないに設定されています。!!"
				Else
					Goto oBad
				End If
			End If
			msgbox(oALE,0,"[ AutoloadEnabled ]")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose
			Kill(sURL) 
End Sub

GDp-)[General]自動更新設定状態の取得2



Sub oGetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'get the Property
			oprop = oDoc.getDocumentProperties().AutoloadEnabled
			If oprop = true then
				oDisp = "自動更新するに設定されています。!!"
				oDisp = oDisp & Chr$(10) & oALE & Chr$(10)
				oDisp = oDisp & "このDocumentを以下の時間毎に更新する" & Chr$(10)
					ot = oDoc.getDocumentInfo().AutoloadSecs
					 oDisp = oDisp & " 更新間隔(sec) = " & ot
			Else 
				If oprop = false then
					oDisp = "自動更新しないに設定されています。!!"
				Else
					Goto oBad
				End If
			End If
			msgbox(oDisp,0,"[ AutoloadEnabled / AutoloadSecs ]")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose
End Sub

GDp-)[General]自動更新設定状態の取得3



Sub oGetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'get the Property
			oprop = oDoc.getDocumentProperties().AutoloadEnabled
			If oprop = true then
				oDisp = "自動更新するに設定されています。!!"
				oDisp = oDisp & Chr$(10) & Chr$(10)
				oDisp = oDisp & "このDocumentを以下の時間毎に更新する"
					ot = oDoc.getDocumentInfo().AutoloadSecs
						oDisp = oDisp & Chr$(10)
						oDisp = oDisp & " 更新間隔(sec) = " & ot
						ou = oDoc.getDocumentInfo().AutoloadURL
						oDisp = oDisp & Chr$(10) & Chr$(10)
						oDisp = oDisp & "更新時間毎に下記URLへ転送する" & Chr$(10)
							oDisp = oDisp & "転送先URL　：　" & ou
			Else 
				If oprop = false then
					oDisp = "自動更新しないに設定されています。!!"
				Else
					Goto oBad
				End If
			End If
			msgbox(oDisp,0,"[ AutoloadEnabled / AutoloadSecs / AutoloadURL ]")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose
End Sub

GDp-)[General]キーワード取得



Sub oGetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'get the Property
			oprop = oDoc.getDocumentProperties().Keywords
			msgbox(oprop,0,"[ Keywords ]")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose
End Sub

GDp-)[General]タイトル取得



Sub oGetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'get the Property
			oprop = oDoc.getDocumentProperties().Title
			msgbox(oprop,0,"[ Title ]")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose
End Sub

GDp-)[General]テーマ取得



Sub oGetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'get the Property
			oprop = oDoc.getDocumentProperties().Subject
			msgbox(oprop,0,"[ Subject(テーマ) ]")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose
End Sub

GDp-)[General]コメント取得



Sub oGetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'get the Property
			oprop = oDoc.getDocumentProperties().Description
			msgbox(oprop,0,"[ Description ]")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose 
End Sub

GDp-)[General]「ユーザーデータ使用する」Check ON/OFF


Sub UseUserDataDispatch()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "Properties.UseUserData"
		oProp(0).Value = false					' true : check ON / false : check OFF
		oDispatcher.executeDispatch(oFrame, ".uno:SetDocumentProperties", "", 0, oProp())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

GDp-)[General]「元に戻す( Reset ) 」Button Click(1)


Sub UserDataReset()
	Dim oDoc as Object
	Dim oDocProp as Object
		oDoc = ThisComponent
		oDocProp = oDoc.getDocumentProperties()
		oDocProp.resetUserData("UseUserData")
		'
	msgbox "Success"
End Sub

GDp-)[General]自動更新の設定1


Sub oSetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
	Dim document   as object
	Dim dispatcher as object
	Dim args1(1) as new com.sun.star.beans.PropertyValue
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'set Dispatcher
			document = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")		
		'Set the Property
			oprop = oDoc.getDocumentProperties().AutoloadEnabled
			If oprop = true then
				ot = oDoc.getDocumentProperties().AutoloadSecs
					oDisp_before = "自動更新する"
					oDisp = "自動更新する" & Chr$(10) & "に設定されています。!!" & Chr$(10)
					oDisp = oDisp &Chr$(9) & Chr$(9) & "自動更新間隔(sec) = " & ot & Chr$(10)
					oDisp = oDisp & Chr$(10) & "変更しますか？"
					oAns = msgbox(oDisp,4,"変更確認")
				If oAns = 6 then					
						args1(0).Name = "Properties.AutoReload"
						args1(0).Value = false
					dispatcher.executeDispatch(document, ".uno:SetDocumentProperties", "", 0, args1())
				'Store
					Wait(10)
					oDoc.store(true)
				Else
					Goto oClose
				End if
			Else 
				If oprop = false then
					oDisp_before = "自動更新しない"
					oDisp = "自動更新しない" & Chr$(10) & "に設定されています。!!" & Chr$(10)
					oDisp = oDisp & Chr$(10) & "変更しますか？"
					oAns = msgbox(oDisp,4,"変更確認")
					If oAns = 6 then
						tAns = Inputbox("更新間隔時間(sec)を入力して下さい")
						args1(0).Name = "Properties.AutoReload"
						args1(0).Value = true
						args1(1).Name = "Properties.AutoReloadTime"
						args1(1).Value = Int(tAns)
						dispatcher.executeDispatch(document, ".uno:SetDocumentProperties", "", 0, args1())
					'Store
						Wait(10)
						oDoc.store(true)
					Else
						Goto oClose
					End if
				Else
					Goto oBad
				End If
			End If
		'Confirm
			oprop = oDoc.getDocumentProperties().AutoloadEnabled
			If oprop = true then
				ot = oDoc.getDocumentProperties().AutoloadSecs
				oDisp_after = "自動更新する" & Chr$(10)
				oDisp_after = oDisp_after & Chr$(9) & "自動更新間隔(sec) = " & ot & Chr$(10)					
			Else
				oDisp_after = "自動更新しない"
			End If
				oDisp = oDisp_before & Chr$(10)
				oDisp = oDisp & Chr$(9) & Chr$(9) & "から" & Chr$(10)
				oDisp = oDisp & oDisp_after & Chr$(10)
				oDisp = oDisp & Chr$(9) & Chr$(9) & "に設定しました。" & Chr$(10)
			msgbox(oDisp,0,"[ Current AutoloadEnabled ] ]")
		'Close
			oDoc.dispose
		Exit sub
	oClose:
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose
End Sub

GDp-)[General]自動更新の設定2


Sub oSetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
	Dim document   as object
	Dim dispatcher as object
	Dim args1(2) as new com.sun.star.beans.PropertyValue
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'set Dispatcher
			document = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")		
		'Set the Property
			oprop = oDoc.getDocumentProperties().AutoloadEnabled
			If oprop = true then
				ot = oDoc.getDocumentProperties().AutoloadSecs
				ou = oDoc.getDocumentProperties().AutoloadURL
					oDisp_before = "自動更新する"
					oDisp = "自動更新する" & Chr$(10) & "に設定されています。!!" & Chr$(10)
					oDisp = oDisp &Chr$(9) & Chr$(9) & "自動更新間隔(sec) = " & ot & Chr$(10)
					oDisp = oDisp &Chr$(9) & Chr$(9) & "Backup URL = " & ou & Chr$(10)
					oDisp = oDisp & Chr$(10) & "変更しますか？"
					oAns = msgbox(oDisp,4,"変更確認")
				If oAns = 6 then					
						args1(0).Name = "Properties.AutoReload"
						args1(0).Value = false
					dispatcher.executeDispatch(document, ".uno:SetDocumentProperties", "", 0, args1())
				'Store
					Wait(10)
					oDoc.store(true)
				Else
					Goto oClose
				End if
			Else 
				If oprop = false then
					oDisp_before = "自動更新しない"
					oDisp = "自動更新しない" & Chr$(10) & "に設定されています。!!" & Chr$(10)
					oDisp = oDisp & Chr$(10) & "Backup file自動作成" & Chr$(10)
					oDisp = oDisp & Chr$(9) & Chr$(9) & "に変更しますか？"
					oAns = msgbox(oDisp,4,"変更確認")
					If oAns = 6 then
						tAns = Inputbox("更新間隔時間(sec)を入力して下さい")
						If NOT IsNumeric(tAns) and tAns < 0 then
							oDisp = "不正な値が入力されました。" & Chr$(10) & Chr$(10) & "終了します。"
							msgbox(oDisp,0,"Caution!!")
							Goto oClose
						End If
						uAns = Inputbox("Backup URL を入力して下さい。　例)  file:///C:/temp/temp1/oAuthor_backup.ods ")
						If NOT FileExists(uAns) then
							oDisp = "Fileが存在しません。!!" & Chr$(10) & "既存Fileを指定して下さい。!!" & Chr$(10) & Chr$(10) & "終了します。"
							msgbox(oDisp,0,"Caution!!")
							Goto oClose
						End If
						args1(0).Name = "Properties.AutoReload"
						args1(0).Value = true
						args1(1).Name = "Properties.AutoReloadTime"
						args1(1).Value = Int(tAns)
						args1(2).Name = "Properties.AutoReloadURL"
						args1(2).Value = uAns
						dispatcher.executeDispatch(document, ".uno:SetDocumentProperties", "", 0, args1())
					'Store
						Wait(10)
						oDoc.store(true)
					Else
						Goto oClose
					End if
				Else
					Goto oBad
				End If
			End If
		'Confirm
			oprop = oDoc.getDocumentProperties().AutoloadEnabled
			If oprop = true then
				ot = oDoc.getDocumentProperties().AutoloadSecs
				ou = oDoc.getDocumentProperties().AutoloadURL
				oDisp_after = "自動更新する" & Chr$(10)
				oDisp_after = oDisp_after & Chr$(9) & "更新間隔(sec) = " & ot & Chr$(10)	
				oDisp_after = oDisp_after & Chr$(9) & "BuckUp URL = "http://error.fc2.com/web/404.html"自動更新しない"
			End If
				oDisp = oDisp_before & Chr$(10)
				oDisp = oDisp & Chr$(9) & Chr$(9) & "から" & Chr$(10)
				oDisp = oDisp & oDisp_after & Chr$(10)
				oDisp = oDisp & Chr$(9) & Chr$(9) & "に設定しました。" & Chr$(10)
			msgbox(oDisp,0,"[ Current AutoloadEnabled ] ]")
		'Close
			oDoc.dispose
		Exit sub
	oClose:
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose
End Sub

GG-2)[General]UserFuield情報の設定(Old)



Sub oXDocInfoSupplier
	Dim oDocInfo As Object
	Dim oInfo$ As String
	Dim i%
		oDocInfo = ThisComponent.getDocumentInfo()	' ← 廃止
		oDocInfo.setUserFieldValue(1, "My special user value")
		for i% = 0to oDocInfo().getUserFieldCount()-1
			oInfo$ = oInfo$ & oDocInfo.getUserFieldName(i) & " = " & _
			CStr(oDocInfo.getUserFieldValue(i)) &Chr$(10)
		next
		Msgbox(oInfo$, 0, "InfoField")
End Sub

GDp-)[General]キーワード設定


Sub oSetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
	Dim document   as object
	Dim dispatcher as object
	Dim args1(2) as new com.sun.star.beans.PropertyValue
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'set Dispatcher
			document = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")		
		'Set the Property
			oprop = oDoc.getDocumentProperties().Keywords
				oDisp_before = "[ Old Keywords ]" & Chr$(10) 
				oDisp_before = oDisp_before & Chr$(9) & oprop & Chr$(10) & Chr$(10)
					oDisp = "[ KeyWord ] " & Chr$(10)
					oDisp = oDisp &Chr$(9) & oprop & Chr$(10)
					oDisp = oDisp & Chr$(10) & "変更しますか？"
					oAns = msgbox(oDisp,4,"変更確認")
				If oAns = 6 then	
					iAns = InputBox("KeyWordsを入力して下さい。"　& Chr$(10) & "例) OpenOffice.org / macro")				
						args1(0).Name = "Properties.KeyWords"
						args1(0).Value = iAns
					dispatcher.executeDispatch(document, ".uno:SetDocumentProperties", "", 0, args1())
				'Store
					Wait(10)
					oDoc.store(true)
				Else
					Goto oClose
				End if
					'Confirm
			oprop = oDoc.getDocumentProperties().KeyWords
				oDisp_after = "New Keywords " & Chr$(10)
				oDisp_after = oDisp_after & Chr$(9) & oprop & Chr$(10)
			'Display
				oDisp = oDisp_before & Chr$(10)
				oDisp = oDisp & Chr$(9) & Chr$(9) & "から" & Chr$(10)
				oDisp = oDisp & oDisp_after & Chr$(10)
				oDisp = oDisp & Chr$(9) & Chr$(9) & "に設定しました。" & Chr$(10)
			msgbox(oDisp,0,"[ Properties ]")
		'Close
			oDoc.dispose
		Exit sub
	oClose:
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose
End Sub

GDp-)[General]タイトル取得設定


Sub oSetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
	Dim document   as object
	Dim dispatcher as object
	Dim args1(2) as new com.sun.star.beans.PropertyValue
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'set Dispatcher
			document = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")		
		'Set the Property
			oprop = oDoc.getDocumentProperties().Title
				oDisp_before = "[ Old Title ]" & Chr$(10) 
				oDisp_before = oDisp_before & Chr$(9) & oprop & Chr$(10) & Chr$(10)
					oDisp = "[ Title ] " & Chr$(10)
					oDisp = oDisp &Chr$(9) & oprop & Chr$(10)
					oDisp = oDisp & Chr$(10) & "変更しますか？"
					oAns = msgbox(oDisp,4,"変更確認")
				If oAns = 6 then	
					iAns = InputBox("Titleを入力して下さい。"　& Chr$(10) & "例) OpenOffice.org / macro , Title ")				
						args1(0).Name = "Properties.Title"
						args1(0).Value = iAns
					dispatcher.executeDispatch(document, ".uno:SetDocumentProperties", "", 0, args1())
				'Store
					Wait(10)
					oDoc.store(true)
				Else
					Goto oClose
				End if
					'Confirm
			oprop = oDoc.getDocumentProperties().Title
			
				oDisp_after = "[ New Title ]" & Chr$(10)
				oDisp_after = oDisp_after & Chr$(9) & oprop & Chr$(10)
			'Display
				oDisp = oDisp_before & Chr$(10)
				oDisp = oDisp & Chr$(9) & Chr$(9) & "から" & Chr$(10) & Chr$(10)
				oDisp = oDisp & oDisp_after & Chr$(10)
				oDisp = oDisp & Chr$(9) & Chr$(9) & "に設定しました。" & Chr$(10)
			msgbox(oDisp,0,"[ Properties ]")
		'Close
			oDoc.dispose
		Exit sub
	oClose:
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose
End Sub

GDp-)[General]テーマ設定


Sub oSetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
	Dim document   as object
	Dim dispatcher as object
	Dim args1(2) as new com.sun.star.beans.PropertyValue
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'set Dispatcher
			document = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")		
		'Set the Property
			oprop = oDoc.getDocumentProperties().Subject
				oDisp_before = "[ Old Subject ]" & Chr$(10) 
				oDisp_before = oDisp_before & Chr$(9) & oprop & Chr$(10) & Chr$(10)
					oDisp = "[ Subject ] " & Chr$(10)
					oDisp = oDisp &Chr$(9) & oprop & Chr$(10)
					oDisp = oDisp & Chr$(10) & "変更しますか？"
					oAns = msgbox(oDisp,4,"変更確認")
				If oAns = 6 then	
					iAns = InputBox("Subjectを入力して下さい。"　& Chr$(10) & "例) OpenOffice.org / macro , Subject ")				
						args1(0).Name = "Properties.Subject"
						args1(0).Value = iAns
					dispatcher.executeDispatch(document, ".uno:SetDocumentProperties", "", 0, args1())
					'Parameter to be stored
						sName = "c:\temp\oAuthor.ods"
						sURL = ConvertToUrl(sName)
					'New Store
						oStore(0).Name="Overwrite"
						oStore(0).Value=true
					oDoc.storeAsUrl(sURL, oStore())
				Else
					Goto oClose
				End if
					'Confirm
			oprop = oDoc.getDocumentProperties().Subject			
				oDisp_after = "[ New Subject ]" & Chr$(10)
				oDisp_after = oDisp_after & Chr$(9) & oprop & Chr$(10)
			'Display
				oDisp = oDisp_before & Chr$(10)
				oDisp = oDisp & Chr$(9) & Chr$(9) & "から" & Chr$(10) & Chr$(10)
				oDisp = oDisp & oDisp_after & Chr$(10)
				oDisp = oDisp & Chr$(9) & Chr$(9) & "に設定しました。" & Chr$(10)
			msgbox(oDisp,0,"[ Properties ]")
		'Close
			oDoc.dispose
		Exit sub
	oClose:
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose
End Sub

GDp-)[General]コメント設定


Sub oSetDocumentInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
	Dim document   as object
	Dim dispatcher as object
	Dim args1(2) as new com.sun.star.beans.PropertyValue
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'set Dispatcher
			document = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")		
		'Set the Property
			oprop = oDoc.getDocumentProperties().Description
				oDisp_before = "[ Old Description ]" & Chr$(10) 
				oDisp_before = oDisp_before & Chr$(9) & oprop & Chr$(10) & Chr$(10)
					oDisp = "[ Description ] " & Chr$(10)
					oDisp = oDisp &Chr$(9) & oprop & Chr$(10)
					oDisp = oDisp & Chr$(10) & "変更しますか？"
					oAns = msgbox(oDisp,4,"変更確認")
				If oAns = 6 then	
					iAns = InputBox("Discriptiontを入力して下さい。"　& Chr$(10) & "例) OpenOffice.org / macro ")				
						args1(0).Name = "Properties.Description"
						args1(0).Value = iAns
					dispatcher.executeDispatch(document, ".uno:SetDocumentProperties", "", 0, args1())
					'Parameter to be stored
						sName = "c:\temp\oAuthor.ods"
						sURL = ConvertToUrl(sName)
					'New Store
						oStore(0).Name="Overwrite"
						oStore(0).Value=true
					oDoc.storeAsUrl(sURL, oStore())
				Else
					Goto oClose
				End if
					'Confirm
			oprop = oDoc.getDocumentProperties().Description			
				oDisp_after = "[ New Description ]" & Chr$(10)
				oDisp_after = oDisp_after & Chr$(9) & oprop & Chr$(10)
			'Display
				oDisp = oDisp_before & Chr$(10)
				oDisp = oDisp & Chr$(9) & Chr$(9) & "から" & Chr$(10) & Chr$(10)
				oDisp = oDisp & oDisp_after & Chr$(10)
				oDisp = oDisp & Chr$(9) & Chr$(9) & "に設定しました。" & Chr$(10)
			msgbox(oDisp,0,"[ Properties ]")
		'Close
			oDoc.dispose
		Exit sub
	oClose:
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			msgbox(mErr & " : i = " & i )
			oDoc.dispose
End Sub

'マクロのテスト OpenOffice.org Basic / ファイル ⇒ プロパティ― ⇒ 概要 ⇒ Description

GDp-)[General]設定Property一覧



Sub oXPropertySet
	Dim oDummy()
	Dim oPropertyInfo As Object
	Dim oProperty()
	Dim oProp
	Dim oVal
	Dim i%
	Dim sInfo$ As String
	Dim oCount%
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		oPropertyInfo = oDoc.getDocumentProperties()
		oProperty = oPropertyInfo.properties()
		for i = 0 to UBound(oProperty)
			If oCount = 50 then
				oCount = 0
				MsgBox(sInfo, 0, "Properties") 
				sInfo =""
			End if
			oCount = oCount +1
			oProp = oProperty(i)
			sInfo = sInfo & oProp.Name & " =  "
			oVal = ThisComponent.getPropertyValue(oProp.Name)
			If IsNull(oVal) then
				sInfo = sInfo & "Null"
			ElseIf IsEmpty(oVal) then
						sInfo = sInfo & "Empty"
			ElseIf VarType(oVal) < 9 then
						sInfo = sInfo & CStr(oVal)
				Else
						sInfo = sInfo & ""	:	'Data is "Object or Array"
			End If
			sInfo = sInfo & Chr$(10)
		next i
		MsgBox(sInfo, 0, "XPropertyset")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
End Sub

GDp-)[General]Read onlyで開いたfileを変更可能か?



Sub ogetPropertySetInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'getPropertySetInfo
			oprop = oDoc.IsChangeReadonlyEnabled
			oDisp = "[ IsChangeReadonlyEnabled ]" & Chr$(10) & Chr$(9) & Chr$(9)
			oDisp = oDisp & oprop
		'Display
			msgbox(oDisp, 0, " [ Property Set Information ]  ")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
End Sub

GDp-)[General]自動高さ調整機能



Sub ogetPropertySetInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'getPropertySetInfo
			oprop = oDoc.IsAdjustHeightEnabled
			oDisp = "[ IsAdjustHeightEnabled ]" & Chr$(10) & Chr$(9) & Chr$(9)
			oDisp = oDisp & oprop
		'Display
			msgbox(oDisp, 0, " [ Property Set Information ]  ")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
End Sub

GDp-)[General]Undo(戻る)機能



Sub ogetPropertySetInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'getPropertySetInfo
			oprop = oDoc.IsUndoEnabled
			oDisp = "[ IsUndoEnabled ]" & Chr$(10) & Chr$(9) & Chr$(9)
			oDisp = oDisp & oprop
		'Display
			msgbox(oDisp, 0, " [ Property Set Information ]  ")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
End Sub

GDp-)[General]Undo可能Step数



Sub ogetPropertySetInfo
	Dim oDoc
	Dim oDummy()
	Dim oStore(0) As new com.sun.star.beans.PropertyValue 
	Dim oprop
		On Error Goto oBad
		sName = "c:\temp\oAuthor.ods"
		sURL = ConvertToUrl(sName)
		oDoc = StarDesktop.loadComponentFromURL(sURL, "_default", 0, oDummy())
		Wait(10)
		'getPropertySetInfo
			oprop = oDoc.IterationCount
			oDisp = "[ IterationCount ]" & Chr$(10) & Chr$(9) & Chr$(9)
			oDisp = oDisp & oprop
		'Display
			msgbox(oDisp, 0, " [ Property Set Information ]  ")
		'Close
			oDoc.dispose
		Exit sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
End Sub

GDPp-)[General]UntiledPrefix



Sub oPropInfo
	Dim oDoc
	Dim oDummy()
		On Error Goto oBad 
			oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, oDummy())
				oprop = oDoc.UntitledPrefix
			msgbox(oprop,0,"[ UntitledPrefix ]")
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
End SUb

[ Document Property2 ]

GDPp-)[ Write / Calc / Draw / Impress ]BuildId



Sub oPropInfo()
	Dim oDoc as Object
	Dim oDummy()
		On Error Goto oBad 
			oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, oDummy())
				oprop = oDoc.BuildId
			msgbox(oprop,0,"[ BuildId ]")
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
End SUb

GDPp-)[ Write / Calc / Draw / Impress ]Namespace



Sub oPropInfo()
	Dim oDoc as Object
	Dim oDummy()
		On Error Goto oBad 
			oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, oDummy())
				oprop = oDoc.Namespace
			msgbox(oprop,0,"[ Namespace ]")
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
End SUb

GDPp-)[ Write / Calc / Draw / Impress ]RuntimeUID



Sub oPropInfo()
	Dim oDoc as Object
	Dim oDummy()
		On Error Goto oBad 
			oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, oDummy())
				oprop = oDoc.RuntimeUID
			msgbox(oprop,0,"[ RuntimeUID ]")
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
End SUb

GDPp-)[ Write / Calc / Draw / Impress ]StringValue



Sub oPropInfo()
	Dim oDoc as Object
	Dim oDummy()
		On Error Goto oBad 
			oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, oDummy())
				oprop = oDoc.StringValue
			msgbox(oprop,0,"[ StringValue ]")
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
End SUb

[ Document Property3 ]

GDPp-)[ Calc / Draw / Impress ]LocalName



Sub oPropInfo
	Dim oDoc
	Dim oDummy()
		On Error Goto oBad 
			oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, oDummy())
				oprop = oDoc.LocalName
			msgbox(oprop,0,"[ LocalName ]")
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
End SUb

[ Document Property4 ]

GDPp-)[ Impress / Math / Base ]ImplementationName



Sub oPropInfo
	Dim oDoc
	Dim oDummy()
		On Error Goto oBad 
			oDoc = StarDesktop.loadComponentFromURL("private:factory/smath", "_blank", 0, oDummy())
				oprop = oDoc.ImplementationName
			msgbox(oprop,0,"[ ImplementationName ]")
			oDoc.dispose
			Exit Sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
			oDoc.dispose
End SUb

[ Document Type ]

GDTyp-)[General]Document Type一覧取得



Sub DocumentType
	Dim oTypeDetection as Object
	Dim oElements as Object
	Dim oDisp as String
		oTypeDetection = CreateUnoService("com.sun.star.document.TypeDetection")
  		oElements = oTypeDetection.getElementNames(oURL)
  		oDisp = ""
  		For i = 0 To UBound(oElements)
    		oDisp = oDisp & oElements(i) & chr(10)
  		Next i
  		'
  		msgbox oDisp,0,"List of Fileter Name"
End Sub

GDTyp-)[General]読込み時のDocument Type



Sub DocumentType
	Dim oTypeDetection as Object
	Dim oDocType as String
	Dim oDisp as String
	Dim oFile as String
	Dim oURL as String
		oTypeDetection = CreateUnoService("com.sun.star.document.TypeDetection")
  		'
  		oFile = "c:\temp\MacroCalc.ods"
  		oURL = ConvertToUrl(oFile)
  		oDocType = oTypeDetection.queryTypeByURL(oURL)
 		oDisp = oDocType
  		'
  		msgbox oDisp,0,"読込み時のDocument Type"
End Sub

GDTyp-)[General]

[ Number Format ]

GDNmFt-)[General]Stabdard



Sub FormatProp()
	Dim oDoc as Object
	Dim oAllFormat as Object
	Dim oFormat as Object
	Dim oPropVals() as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oAllFormat = oDoc.getNumberFormats()
		oFormat = oAllFormat.getByKey(0)
		oPropVals = oFormat.getPropertyValues
		oDisp = "[ Number Format of Document ]" & Chr$(10) & Chr$(10) & _
			"*** [ Name of Properties ] ***" & Chr$(10) & Chr$(9) & "Value" & Chr$(9) & _
			"/ Handle" & Chr$(9) & "/ State" & Chr$(10) & Chr$(10)
		for i = 0 to UBound(oPropVals)
			if oPropVals(i).Name <> "Comment" and oPropVals(i).Name <> "Locale" _
					and oPropVals(i).Name <> "Type" then
				oDisp = oDisp & "*** [ " & oPropVals(i).Name & " ] ***" & Chr$(10)
				if NOT IsEmpty(oPropVals(i).Value) then
					oDisp = oDisp & Chr$(9) &  oPropVals(i).Value & Chr$(9) & "/ "
				else
					oDisp = oDisp & Chr$(9) &  "     " & Chr$(9) & "/ "
				end if
				if NOT IsEmpty(oPropVals(i).Handle) then
					oDisp = oDisp & oPropVals(i).Handle & Chr$(9) & "/ "
				else
					oDisp = oDisp & "     " & Chr$(9) & "/ "
				end if
				if NOT IsEmpty(oPropVals(i).State) then
					oDisp = oDisp & oPropVals(i).State & Chr$(10)
				else
					oDisp = oDisp & "     " & Chr$(10)
				end if
			end if
		next i
		msgbox(oDisp,0,"Number Format")
End Sub
'
' [ Note ]
' Number Format値はReadOnly

GDNmFt-)[General]FormatString = 0



Sub FormatProp()
	Dim oDoc as Object
	Dim oAllFormat as Object
	Dim oFormat as Object
	Dim oPropVals() as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oAllFormat = oDoc.getNumberFormats()
		oFormat = oAllFormat.getByKey(1)
		oPropVals = oFormat.getPropertyValues
		oDisp = "[ Number Format of Document ]" & Chr$(10) & Chr$(10) & _
			"*** [ Name of Properties ] ***" & Chr$(10) & Chr$(9) & "Value" & Chr$(9) & _
			"/ Handle" & Chr$(9) & "/ State" & Chr$(10) & Chr$(10)
		for i = 0 to UBound(oPropVals)
			if oPropVals(i).Name <> "Comment" and oPropVals(i).Name <> "Locale" _
					and oPropVals(i).Name <> "Type" then
				oDisp = oDisp & "*** [ " & oPropVals(i).Name & " ] ***" & Chr$(10)
				if NOT IsEmpty(oPropVals(i).Value) then
					oDisp = oDisp & Chr$(9) &  oPropVals(i).Value & Chr$(9) & "/ "
				else
					oDisp = oDisp & Chr$(9) &  "     " & Chr$(9) & "/ "
				end if
				if NOT IsEmpty(oPropVals(i).Handle) then
					oDisp = oDisp & oPropVals(i).Handle & Chr$(9) & "/ "
				else
					oDisp = oDisp & "     " & Chr$(9) & "/ "
				end if
				if NOT IsEmpty(oPropVals(i).State) then
					oDisp = oDisp & oPropVals(i).State & Chr$(10)
				else
					oDisp = oDisp & "     " & Chr$(10)
				end if
			end if
		next i
		msgbox(oDisp,0,"Number Format")
End Sub

GDNmFt-)[General]FormatString = 0.00



Sub FormatProp()
	Dim oDoc as Object
	Dim oAllFormat as Object
	Dim oFormat as Object
	Dim oPropVals() as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oAllFormat = oDoc.getNumberFormats()
		oFormat = oAllFormat.getByKey(2)
		oPropVals = oFormat.getPropertyValues
		oDisp = "[ Number Format of Document ]" & Chr$(10) & Chr$(10) & _
			"*** [ Name of Properties ] ***" & Chr$(10) & Chr$(9) & "Value" & Chr$(9) & _
			"/ Handle" & Chr$(9) & "/ State" & Chr$(10) & Chr$(10)
		for i = 0 to UBound(oPropVals)
			if oPropVals(i).Name <> "Comment" and oPropVals(i).Name <> "Locale" _
					and oPropVals(i).Name <> "Type" then
				oDisp = oDisp & "*** [ " & oPropVals(i).Name & " ] ***" & Chr$(10)
				if NOT IsEmpty(oPropVals(i).Value) then
					oDisp = oDisp & Chr$(9) &  oPropVals(i).Value & Chr$(9) & "/ "
				else
					oDisp = oDisp & Chr$(9) &  "     " & Chr$(9) & "/ "
				end if
				if NOT IsEmpty(oPropVals(i).Handle) then
					oDisp = oDisp & oPropVals(i).Handle & Chr$(9) & "/ "
				else
					oDisp = oDisp & "     " & Chr$(9) & "/ "
				end if
				if NOT IsEmpty(oPropVals(i).State) then
					oDisp = oDisp & oPropVals(i).State & Chr$(10)
				else
					oDisp = oDisp & "     " & Chr$(10)
				end if
			end if
		next i
		msgbox(oDisp,0,"Number Format")
End Sub

GDNmFt-)[General]FormatString = #,##0



Sub FormatProp()
	Dim oDoc as Object
	Dim oAllFormat as Object
	Dim oFormat as Object
	Dim oPropVals() as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oAllFormat = oDoc.getNumberFormats()
		oFormat = oAllFormat.getByKey(3)
		oPropVals = oFormat.getPropertyValues
		oDisp = "[ Number Format of Document ]" & Chr$(10) & Chr$(10) & _
			"*** [ Name of Properties ] ***" & Chr$(10) & Chr$(9) & "Value" & Chr$(9) & _
			"/ Handle" & Chr$(9) & "/ State" & Chr$(10) & Chr$(10)
		for i = 0 to UBound(oPropVals)
			if oPropVals(i).Name <> "Comment" and oPropVals(i).Name <> "Locale" _
					and oPropVals(i).Name <> "Type" then
				oDisp = oDisp & "*** [ " & oPropVals(i).Name & " ] ***" & Chr$(10)
				if NOT IsEmpty(oPropVals(i).Value) then
					oDisp = oDisp & Chr$(9) &  oPropVals(i).Value & Chr$(9) & "/ "
				else
					oDisp = oDisp & Chr$(9) &  "     " & Chr$(9) & "/ "
				end if
				if NOT IsEmpty(oPropVals(i).Handle) then
					oDisp = oDisp & oPropVals(i).Handle & Chr$(9) & "/ "
				else
					oDisp = oDisp & "     " & Chr$(9) & "/ "
				end if
				if NOT IsEmpty(oPropVals(i).State) then
					oDisp = oDisp & oPropVals(i).State & Chr$(10)
				else
					oDisp = oDisp & "     " & Chr$(10)
				end if
			end if
		next i
		msgbox(oDisp,0,"Number Format")
End Sub

GDNmFt-)[General]FormatString = #,##0.00



Sub FormatProp()
	Dim oDoc as Object
	Dim oAllFormat as Object
	Dim oFormat as Object
	Dim oPropVals() as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oAllFormat = oDoc.getNumberFormats()
		oFormat = oAllFormat.getByKey(4)
		oPropVals = oFormat.getPropertyValues
		oDisp = "[ Number Format of Document ]" & Chr$(10) & Chr$(10) & _
			"*** [ Name of Properties ] ***" & Chr$(10) & Chr$(9) & "Value" & Chr$(9) & _
			"/ Handle" & Chr$(9) & "/ State" & Chr$(10) & Chr$(10)
		for i = 0 to UBound(oPropVals)
			if oPropVals(i).Name <> "Comment" and oPropVals(i).Name <> "Locale" _
					and oPropVals(i).Name <> "Type" then
				oDisp = oDisp & "*** [ " & oPropVals(i).Name & " ] ***" & Chr$(10)
				if NOT IsEmpty(oPropVals(i).Value) then
					oDisp = oDisp & Chr$(9) &  oPropVals(i).Value & Chr$(9) & "/ "
				else
					oDisp = oDisp & Chr$(9) &  "     " & Chr$(9) & "/ "
				end if
				if NOT IsEmpty(oPropVals(i).Handle) then
					oDisp = oDisp & oPropVals(i).Handle & Chr$(9) & "/ "
				else
					oDisp = oDisp & "     " & Chr$(9) & "/ "
				end if
				if NOT IsEmpty(oPropVals(i).State) then
					oDisp = oDisp & oPropVals(i).State & Chr$(10)
				else
					oDisp = oDisp & "     " & Chr$(10)
				end if
			end if
		next i
		msgbox(oDisp,0,"Number Format")
End Sub

GDNmFt-)[General]FormatString = #,##0.00 / LeadingZeros = 0



Sub FormatProp()
	Dim oDoc as Object
	Dim oAllFormat as Object
	Dim oFormat as Object
	Dim oPropVals() as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oAllFormat = oDoc.getNumberFormats()
		oFormat = oAllFormat.getByKey(5)
		oPropVals = oFormat.getPropertyValues
		oDisp = "[ Number Format of Document ]" & Chr$(10) & Chr$(10) & _
			"*** [ Name of Properties ] ***" & Chr$(10) & Chr$(9) & "Value" & Chr$(9) & _
			"/ Handle" & Chr$(9) & "/ State" & Chr$(10) & Chr$(10)
		for i = 0 to UBound(oPropVals)
			if oPropVals(i).Name <> "Comment" and oPropVals(i).Name <> "Locale" _
					and oPropVals(i).Name <> "Type" then
				oDisp = oDisp & "*** [ " & oPropVals(i).Name & " ] ***" & Chr$(10)
				if NOT IsEmpty(oPropVals(i).Value) then
					oDisp = oDisp & Chr$(9) &  oPropVals(i).Value & Chr$(9) & "/ "
				else
					oDisp = oDisp & Chr$(9) &  "     " & Chr$(9) & "/ "
				end if
				if NOT IsEmpty(oPropVals(i).Handle) then
					oDisp = oDisp & oPropVals(i).Handle & Chr$(9) & "/ "
				else
					oDisp = oDisp & "     " & Chr$(9) & "/ "
				end if
				if NOT IsEmpty(oPropVals(i).State) then
					oDisp = oDisp & oPropVals(i).State & Chr$(10)
				else
					oDisp = oDisp & "     " & Chr$(10)
				end if
			end if
		next i
		msgbox(oDisp,0,"Number Format")
End Sub

GDNmFt-)[General]

User Profile

GDUp-)[General]User Profile( Read only )



Sub test_UserProfileData
	'Look at file <> /org/openoffice/UserProfile.xcu, XML-node "Data":
	Const sNodePath$ = "/org.openoffice.UserProfile/Data"
	On Error Goto oBad
		oNode = getOOoSetupNode(sNodePath$)
		'Get UserProfile
			oSnval = oNode.getByName("sn")
			oGnval = oNode.getByName("givenname")
			oIval = oNode.getByName("initials")
			msgbox("LastName => " & oGnval & Chr$(10) & _
						"FirstName => " & oSnval & Chr$(10) & _
						"Initial => " & oIval, 0, "[ User Profile ]")
			Exit  Sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
End Sub

'[ Function ]
Function getOOoSetupNode(sNodePath$)		' Not to be Changed function name
	Dim aConfigProvider, oNode, args(0) As new com.sun.star.beans.PropertyValue
   		aConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider")
   			args(0).Name = "nodepath"
   			args(0).Value = sNodePath
   		getOOoSetupNode = aConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", args())		'ReadOnly
End Function

GDUp-)[General]User Profile( Modify )


Sub test_UserProfileData
	'Look at file <> /org/openoffice/UserProfile.xcu, XML-node "Data":
	Const oNodePath$ = "/org.openoffice.UserProfile/Data"
	On Error Goto oBad
	'Read UserProfile
		oNode = readUserProfile(oNodePath$)
			oSnval = oNode.getByName("sn")
			oGnval = oNode.getByName("givenname")
			oIval = oNode.getByName("initials")
				oAns = msgbox("Current User Profiles are following; " & Chr$(10) & _
						"LastName => " & oGnval & Chr$(10) & _
						"FirstName => " & oSnval & Chr$(10) & _
						"Initial => " & oIval & Chr$(10) & _
						"Do you want to modify the user profiles really ?", 4, "[ Current User Profile ]")
			If oAns=6 then
				oNode2 = modifyUserProfile(oNodePath$)
					oNode2.sn="change_new_OOo3"
					oNode2.givenname = "Macro"
					oNode2.initials = "ooo"
					oNode2.commitChanges()
			wait(100)
				'Confirm User Profile
					oNode3 = readUserProfile(oNodePath$)
						mSnval = oNode3.getByName("sn")
						mGnval = oNode3.getByName("givenname")
						mIval = oNode3.getByName("initials")
					msgbox("LastName => " & mGnval & Chr$(10) & _
						"FirstName => " & mSnval & Chr$(10) & _
						"Initial => " & mIval, 0, "[ User Profile ]")
			else
				Exit Sub
			End If
			Exit  Sub
	oBad: 
			mErr = Error
			eline = Erl
			msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
End Sub
'[ Function1 ]
Function readUserProfile(oNodePath$)
	Dim oConfigProvider, oNode, args(0) As new com.sun.star.beans.PropertyValue
  		oConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider")		　'ReadOnly
  			args(0).Name = "nodepath"
  			args(0).Value = oNodePath
  		readUserProfile = 　oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", args())	
End Function
'[ Function2 ]
Function modifyUserProfile(sNodePath$)		' Not to be Changed function name
	Dim aConfigProvider, oNode, args(0) As new com.sun.star.beans.PropertyValue
  		aConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider")		'modify
  		args(0).Name = "nodepath"
  		args(0).Value = sNodePath
  		modifyUserProfile = aConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess", args())	'modify
End Function

GDUp-)[General]Country



Sub OOoLang
	Dim oSettings
	Dim oConfigProvider
	Dim oParams(0) as new com.sun.star.beans.PropertyValue
	Dim oProvider$
	Dim oAccess$
		oProvider = "com.sun.star.configuration.ConfigurationProvider"
		oAccess = "com.sun.star.configuration.ConfigurationAccess"
		oConfigProvider = createUnoService(oProvider)
		oParams(0).Name = "nodepath"
		oParams(0).Value = "/org.openoffice.Setup/L10N"
		oSettings = oConfigProvider.createInstanceWithArguments(oAccess, oParams())
		'
		Dim OOLangue as String
			OOLangue = oSettings.getByName("ooLocale")
			MsgBox("OOo is configured with Locale " & Chr$(10) & _
						 Chr$(9) & OOLangue, 0, "OOo Locale")
End Sub

[ Arguments ]

GDPag-)[General]>Args項目


AsTemplate : ファイルを編集ではなく、そのファイルをテンプレートとして新規作成します。テンプレートでないドキュメントを指定した時でも新規になります (テンプレートとして)。また、テンプレートをこのプロパティを指定せずに開くとテンプレートの編集状態になります。
DocumentBaseURL : HTML ドキュメントなどの相対パス指定を含むドキュメントの Base URL を指定します。画像などが相対パスで指定されているときに利用します。
FilterName : ドキュメントを開くとき、または保存するときのフィルター名。このフィルタ名は内部名で指定します。
FilterData : 複雑なフィルタオプションを指定するときによく利用されます。設定内容はフィルタに依存します。
FilterOptions : CSV フィルタなどの簡単なフィルタオプションしか必要ない場合に利用されています。
JumpMark : ドキュメントを開いたときに指定されたブックマーク位置を表示します。
MediaType : TypeDetection にタイプ判定を任せないときに使用します。まちがった指定をすると開くのに失敗します。
MacroExecutionMode : マクロのセキュリティモードをそのドキュメントのみに対して指定します。実行したいマクロを含むドキュメントを別のマクロから開くときに必須です (セキュリティモード設定によりますが)。値の指定は com.sun.star.document.MacroExecMode の定数で行います。
OutputStream : ファイルではなくストリームにドキュメントを保存します。
Overwrite : 保存時にファイルが存在したときに上書きするか、しない指定をします。
Password : ドキュメントを開くときに必要なパスワードを指定します。または、保存時にパスワード保護できるドキュメント形式の場合に指定できます。
Preview : 「プレビュー」モードで開きます。なぜかツールバーからステータスバー、スクロールバーが表示されないので見難いです。
RepairPackage : 壊れたドキュメントを修復してから開こうとします。
StartPresentation : Impress ドキュメントを開いたときにプレゼンテーションモードにすぐに切り替えます。
TemplateName : TemplateRegionName とセットで利用します。テンプレート名を指定します。
TemplateRegionName : TemplateName とセットで利用します。
UpDateDocMode : ドキュメント中にあるリンクの更新動作を指定します。指定は com.sun.star.document.UpdateDocMode の定数で行います。
Unpacked : 保存時に zip 圧縮しない。その代わりにディレクトリ内に保存します。画像等がある場合
Version : バージョンがある場合に指定したバージョンを開きます。ゼロの時にはもっとも新しいものを開きます。以前のバージョンは読み込みせんようになります。

GDPag-)[General]Args取得(1)



Sub oGetArgs
	Dim oArgs
	Dim oDcArgs$ as String
	Dim i%
		On Error Resume Next
			oArgs = ThisComponent.getArgs()
			for i = 0 to UBound(oArgs)
				oDocArgs = oDocArgs & oArgs(i).Name & " = "
				oDocArgs = oDocArgs & oArgs(i).Value
				oDocArgs = oDocArgs & Chr$(10)
			next i
		msgbox(oDocArgs, 0, "Property Args of ThisCompoment")
End Sub

GDPag-)[General]Args取得(2)



Sub oDocArgs
	Dim oDoc
	Dim OOo
	Dim SufOOo
	Dim oTempName
	Dim oDummy()
	Dim oArray(0)  As New com.sun.star.beans.PropertyValue
	Dim oProp
		oProp = "Args"
		' Initialize Display
			oDisp = "<< " & oProp & " >>" & Chr$(10)
			for n= 0 to 5
				Select case n
					case = 0
						OOo = "writer"
						SufOOo = "odt"
					case = 1
						OOo = "calc"
						SufOOo = "ods"
					case = 2
						OOo = "draw"
						SufOOo = "odg"
					case = 3
						OOo = "impress"
						SufOOo = "odp"
					case = 4
						OOo = "math"
						SufOOo = "odf"
					case = 5
						OOo = "database"
						SufOOo = "odb"
				End Select
				oDoc = StarDesktop.loadComponentFromURL("private:factory/s" & OOo , "_blank", 0, oDummy())
				oTempName = ConvertToUrl("c:\temp\oDocProp." & SufOOo)
				oArray(0).Name = "Overwrite"
				oArray(0).Value = true
				oDoc.storeAsURL(oTempName,oArray())
			'Properties [ Array ]
				Dim oArgs
				Dim i%
		On Error Resume Next
			oDisp = oDisp & "[  " & OOo & "  ]" & Chr$(10)
			oArgs = oDoc.Args
			for i = 0 to UBound(oArgs)
				oDisp = "   " & oDisp & oArgs(i).Name & " = "
				oDisp = oDisp & oArgs(i).Value
				oDisp = oDisp & Chr$(10)
			next i
			oDisp = oDisp & Chr$(10)
			oDoc.close(true)
				If n > 5 then Exit Sub
			next n
		If oDisp = "<< " & oProp & " >>" & Chr$(10) & "   " then
			oDisp = oDisp & Chr$(10) & "  に関する情報はありません"
		End If
		msgbox(oDisp, 0, oProp & " of Properties" )						
End Sub

GDPas-)[General]Args設定



Sub oMainArgsSet
	Dim oArgs(2) As New com.sun.star.beans.PropertyValue 
	Dim oDoc
		oFileName = "c:\temp\oDocPara.ods" 
		oURL = ConvertToUrl(oFileName)
			oArgs(0).Name="FilterName"
			oArgs(0).Value= "calc8"
			oArgs(1).Name="MacroExecutionMode"
			oArgs(1).Value = com.sun.star.document.MacroExecMode.NEVER_EXECUTE		'Value = 0
			'oArgs(1).Value = com.sun.star.document.MacroExecMode.ALWAYS_EXECUTE_NO_WARN	' Value = 4
			oArgs(2).Name="UpdateDocMode"
			oArgs(2).Value= com.sun.star.document.UpdateDocMode.NO_UPDATE	' Value = 0
		oDoc = StarDesktop.LoadComponentFromUrl("private:factory/scalc", "_blank", 6, oArgs())
		Dim oStoreFile(0) As New com.sun.star.beans.PropertyValue 
			oStoreFile(0).Name = "Overwrite"
			oStoreFile(0).Value = true
			oDoc.storeAsURL(oURL,oStoreFile())
	Dim oGArgs	
		oGArgs = oDoc.getArgs()
	On Error Resume Next
		for i = 0 to UBound(oGArgs)
			oDocArgs = oDocArgs & oGArgs(i).Name & " = "
			oDocArgs = oDocArgs & oGArgs(i).Value
			oDocArgs = oDocArgs & Chr$(10)
		next i
		msgbox(oDocArgs, 0, "Set Arguements of Document")
End Sub

[ View Information ]

GDPv-1)[General]DocumentのView情報



Sub oXViewDataSup()
	Dim oViewDataObj As Object
	Dim i%
	Dim j%
	Dim oResult$
	Dim oViewData
		On Error Resume Next
		oViewDataObj = ThisComponent.getViewData()
		For i = 0 to oViewDataObj.getCount()-1
			oViewData = oViewDataObj.getByIndex(i)
			for j =0 to UBound(oViewData)
				oResult = oResult & oViewData(j).Name & " = "
				oResult = oResult & CStr(oViewData(j).Value) & Chr$(10)
			next j
			MsgBox(oResult, 0, "View Data No." & i)
		next i
End Sub

GDPv-3)[General]ViewId取得(1)


Sub oViewID1
	Dim oDoc
	Dim oArgs
	'On Error Resume Next
		oDoc = ThisComponent
			oArgs = oDoc.Args
			for i = 0 to UBound(oArgs)
				if oArgs(i).Name = "ViewId" then
					oArgs_Value =oArgs(i).Value
				End If
			next i
		msgbox (oArgs_Value,0,"ViewId No") 
End Sub

GDPv-3)[General]ViewId取得(2)


Sub oViewID2
	Dim oDoc
	Dim oArgs
	'On Error Resume Next
		oDoc = ThisComponent
			oArgs = oDoc.getArgs()
			for i = 0 to UBound(oArgs)
				if oArgs(i).Name = "ViewId" then
					oArgs_Value =oArgs(i).Value
				End If
			next i
		msgbox (oArgs_Value,0,"ViewId No") 
End Sub

View

GDVw-)[General]Status Bar表示/非表示



Sub GeneralUnoView()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch( oFrame, ".uno:StatusBarVisible", "", 0, oProp())
		msgbox "Status Bar非表示",0,"View"
		'
		oDispatcher.executeDispatch( oFrame, ".uno:StatusBarVisible", "", 0, oProp())
		msgbox "Status Bar表示",0,"View"
End Sub

GDVw-)[General]Data Source欄表示/非表示



Sub GeneralUnoView()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch( oFrame, ".uno:ViewDataSourceBrowser", "", 0, oProp())
		msgbox "DataSource欄表示",0,"View"
		'
		oDispatcher.executeDispatch( oFrame, ".uno:ViewDataSourceBrowser", "", 0, oProp())
		msgbox "DataSource欄非表示",0,"View"
End Sub

GDVw-)[General]Navigator Window表示/非表示



Sub GeneralUnoView()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch( oFrame, ".uno:Navigator", "", 0, oProp())
		msgbox "Navigator Window表示",0,"View"
		'
		oDispatcher.executeDispatch( oFrame, ".uno:Navigator", "", 0, oProp())
		msgbox "Navigator Window非表示",0,"View"
End Sub

GDVw-)[General]Design Mode ON/OFF



Sub GeneralView()
	Dim oDoc as Object, oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		' Form Design Barは表示済み
		oCtrl.FormDesignMode = true
		msgbox "Form Design Mode / ON",0,"CalcView"
		'
		oCtrl.FormDesignMode = false
		msgbox "Form Design Mode / OFF",0,"ClacView"
End Sub

GDVw-)[General]

Style

GS-1)[General]Page枚数をCountして、Page番号を付ける。


Sub oAdditional_Page_Number
	Dim oDoc As Object
   		oDoc = ThisComponent
   			oPageStyles = oDoc.StyleFamilies.getByName("PageStyles")
   			oDefault = oPageStyles.getByName("Default")
   				oDefault.FooterIsOn = true  
   				oFooter = oDefault.RightPageFooterContent
   					oPageNumber = oDoc.createInstance("com.sun.star.text.TextField.PageNumber")   
   					oTextCursor = oFooter.RightText.createTextCursor
   					oTextCursor.gotoEnd (False)
   					oTextCursor.String = "Page"
   					oTextCursor.gotoEnd (False)
   					oFooter.RightText.insertTextContent (oTextCursor, oPageNumber, True)
   				oPageCount = oDoc.createInstance ("com.sun.star.text.TextField.PageCount")
   					oTextCursor.gotoEnd (False)
   					oTextCursor.String = " of "
   					oTextCursor.gotoEnd (False)
   					oFooter.RightText.insertTextContent(oTextCursor, oPageCount, true)
   					oDefault.RightPageFooterContent = oFooter
End Sub

[ Note ]：本マクロはPage番号を追加するものであるので、実行させた数分のPageの記述が入る。

GS-3)Page番号追加して削除する。


Sub oPageNum_ADD_and_Remove
	Dim oDoc As Object
		oDoc = ThisComponent
		oPageStyle = oDoc.StyleFamilies.getByName("PageStyles")
		oDefault = oPageStyle.getByName("Default")
			oDefault.FooterIsOn  =true
			oFooter = oDefault.RightPageFooterContent
				oPageNumber = oDoc.createInstance("com.sun.star.text.TextField.PageNumber")
				oPageCount = oDoc.createInstance("com.sun.star.text.TextField.PageCount")	
				oTextCursor = oFooter.RightText.createTextCursor
				oTextCursor.gotoEnd(False)
				oTextCursor.String = "Page "
				oTextCursor.gotoEnd(False)
				oFooter.RightText.insertTextContent(oTextCursor, oPageNumber, True)
				oTextCursor.gotoEnd(False)
				oTextCursor.String = " of  "
				oTextCursor.gotoEnd(False)
				oFooter.RightText.insertTextContent(oTextCursor, oPageCount, True)
				oFooter.RightText.removeTextContent(oPageNumber)
				oFooter = oDefault.RightPageFooterContent
				oFooter.RightText.removeTextContent(oPageCount)
				oDefault.RightPageFooterContent = oFooter
End Sub

GS-4)[General]用紙サイズをA4縦に設定する。


Option Explicit
Sub Page_Size_Defualt_A4
	Dim oDoc As Object
	Dim oPageStyle As Object
	Dim oDefault As Object
	Dim oPrintOptions(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oPageStyle = oDoc.StyleFamilies.getByName("PageStyles")
			oDefault = oPageStyle.getByName("Default")
		'Paper Size
			oDefault.Width = 21000 'Unit:mm
			oDefault.Height = 29700 'Unit:mm
		'Print Option
			oPrintOptions(0).Name = "A4"
			oPrintOptions(0).Value = com.sun.star.view.PaperOrientation.LANDSCAPE
			oDoc.Printer = oPrintOptions()
End Sub

GS-5)[General]異なる用紙サイズを設定する


Option Explicit
Sub setPage_Size(optional oPaper As String,optional oOrient As String)
	Dim oDoc As Object
	Dim oPaperSize(5,2)
	Dim oPageStyle As Object
	Dim oDefault As Object
	Dim oPrintOptions(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oPageStyle = oDoc.StyleFamilies.getByName("PageStyles")
			oDefault = oPageStyle.getByName("Default")
			If IsMissing(oPaper) then
				oPaper = "A4"
			End if
			If isMissing(oOrient) then
				oOrient = "PORTRAIT"
			End if
			oPaperSize("A4",0) = 21000 'Width
			oPaperSize("A4",1) = 29700 'Height
			oPaperSize("A5",0) = 14800
			oPaperSize("A5",1) = 21000
			oDefault.Width = oPaperSize(oPaper,0)
			oDefault.Height =  oPaperSize(oPaper,1)
			oPrintOptions(0).Name = "PaperOrientation"
			if oOrient = "PORTTAIT" then
				oPrintOptions(0).value =  com.sun.star.view.PaperOrientation.PORTRAIT
			else
				oPrintOptions(0).Value = com.sun.star.view.PaperOrientation.LANDSCAPE
			End if
			oDoc.Printer = oPrintOptions()
End Sub

GS-6)[General]Style Type数の取得(XStyleFamiliesSuppliier)


Sub oXStyleFamiliesSupplier1
	Dim oFamilies
	Dim oFamilyNames
	Dim oNumStyle
		oFamilies = ThisComponent.StyleFamilies
		oFamilyNames = oFamilies.getElementNames()
		oNumStyle = UBound(oFamilyNames)+1
		msgBox("本fileにて使用可能なStyleType数は　：　" & oNumStyle & " 種類です。")
End Sub

GS-7)[General]Style Type名、数の取得(XStyleFamiliesSuppliier)



Sub oXStyleFamiliesSupplier2()
	Dim oFamilies
	Dim oFamilyNames
	Dim oStyleType
		oFamilies = ThisComponent.StyleFamilies
		oFamilyNames = oFamilies.getElementNames()
		for n = LBound(oFamilyNames) to UBound(oFamilyNames)
			oStyleType = oFamilies.getByName(oFamilyNames(n))
			oDisp_StyleType = oDisp_StyleType & oFamilyNames(n) & " : " & oStyleType.getCount() & " 種類です" & Chr$(10)
		next n
		msgBox(oDisp_StyleType, 0, "StyleTypes")
End Sub

GS-)[General]Style名一覧を作成する(XStyleFamiliesSuppliier)[Writer,Calc,Draw,Impress]



Sub oXStyleFamiliesSupplier3()
	Dim Dummy()
	Dim oDisplay
	Dim oFamilies
	Dim oFamilyNames(3)
	Dim oStyleType
	Dim oTypeMinNum(3)
	Dim oTypeMaxNum(3)
	Dim oStyleTypeOutput(3, 50)
	Dim oNameMinNum(3, 50)
	Dim oNameMaxNum(3, 50)	
	Dim oStyleNameIndex(3, 50, 200)
	Dim oStyleNames(200)
		'Component Lock(Macro実行の体感速度が速くなる)
		oDisplay = ThisComponent
		oDisplay.lockControllers()
		'oDoc
			 for i = 0 to 3
			 	Select case i
			 		case =0
			 			'Witer
			 				 oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
			 		case =1
			 			'Calc
			 				 oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy()) 
			 		case =2
			 			'Draw
			 				 oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_blank", 0, Dummy())
			 		case =3
			 			'Impress
			 				 oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
			 	End Select
		'Get the StyleFamilies
			oFamilies = oDoc.StyleFamilies
			oFamilyNames = oFamilies.getElementNames()
				oTypeMinNum(i) = LBound(oFamilyNames)
				oTypeMaxNum(i) = UBound(oFamilyNames) 
			'Get the StyleTypes
				for n = LBound(oFamilyNames) to UBound(oFamilyNames)
					oStyleType = oFamilies.getByName(oFamilyNames(n))
						oStyleTypeOutput(i, n) = oFamilyNames(n)
					oStyleNames = oStyleType.getElementNames()
						oNameMinNum(i, n) = LBound(oStyleNames)
						oNameMaxNum(i, n) = UBound(oStyleNames)
					for j = LBound(oStyleNames) to UBound(oStyleNames)						
						oStyleNameIndex(i,n,j) = oStyleNames(j)
					next j						
				next n
			'File Close
				oDoc.dispose
			next i		
		'	
		'出力先file起動
			oIndexName = ConvertToUrl("c:\temp\Macro_StyleIndex.ods")
			oIndexFile_Calc = StarDesktop.loadComponentFromURL(oIndexName, "_blank", 0, Dummy())
			'Style名の出力
				'Calc fileへAccess
					oController = oIndexFile_Calc.getCurrentController()
				'SheetへAccess					
					oSheets = oIndexFile_Calc.getSheets() 
					for i = 0 to 3
						'Writer,Calc,Draw or Impress
						oTitleCell = oIndexFile_Calc.Sheets( i ).getCellByPosition(0, 0)
							Select case i
			 					case =0
			 						'Witer
			 				 			oTitleCell.String = "Style名 一覧 in Writer" 
			 				 				oTitleCell.CharHeight=20
			 				 				oTitleCell.CharHeightAsian=20
			 					case =1
			 						'Calc
			 				 			oTitleCell.String = "Style名一覧 in Calc"
			 				 				oTitleCell.CharHeight=20
			 				 				oTitleCell.CharHeightAsian=20
			 					case =2
			 						'Draw
			 				 			oTitleCell.String = "Style名一覧 in Draw"
			 				 				oTitleCell.CharHeight=20
			 				 				oTitleCell.CharHeightAsian=20
			 					case =3
			 						'Impress
			 				 			oTitleCell.String = "Style名一覧 in Impress" 
			 				 				oTitleCell.CharHeight=20
			 				 				oTitleCell.CharHeightAsian=20
			 				End Select
						'Style名の出力
							for n = oTypeMinNum(i) to oTypeMaxNum(i)
								oIndexFile_Calc.Sheets( i ).getCellByPosition(n, 1).String = oStyleTypeOutput(i, n)
									oIndexFile_Calc.Sheets( i ).getCellByPosition(n, 1).CharHeight = 16
								for j = oNameMinNum(i, n) to oNameMaxNum(i, n) 
									oIndexFile_Calc.Sheets( i ).getCellByPosition(n, j+2).String = oStyleNameIndex(i,n,j)
								next j
							next n
					next i
			'Display UnLock
			oDisplay.unlockControllers() 			
		msgBox("Success")
End Sub

GS-9)[General]設定Style一覧(XStyleFamiliesSuppliier)[Writer,Calc,Draw,Impress]



Sub oDefineStyle()
	Dim Dummy()
	Dim oDisplay
	Dim oObjStyles
	Dim oStyle
	Dim oCount(3)
	Dim oNames(200)
	Dim oOutName(3,200)
	'Define in the com.sun.star.style.Style service		
		Dim oIsUserDefined(3,200)
		Dim oIsInUse(3,200)
		Dim oDisplayName(3,200)
		Dim oIsPhysical(3,200)
		'	Dim oGPS		
		'	Dim oFollowStyle
		'	Dim oIsAutoUpdate
		'get the Value of Defined Service
			for i = 0 to 3
				Select Case i
					case = 0
					'Witer
						oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
					case = 1
					'Calc
						oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
					case = 2
					'Draw
						oDoc = StarDesktop.loadComponentFromURL("private:factory/sdraw", "_blank", 0, Dummy())
					case = 3
					'Impress
						oDoc = StarDesktop.loadComponentFromURL("private:factory/simpress", "_blank", 0, Dummy())
				End Select
				oObjStyles = oDoc.StyleFamilies.getByIndex(i)
					oCount(i) = oObjStyles.getCount - 1
					oNames = oObjStyles.getElementNames()	
					for n = 0 to oCount(i)
						oOutName(i,n) = oNames(n)
						oStyle = oObjStyles.getByName(oNames(n))
						'Style service
							oIsUserDefined(i,n) = CStr(oStyle.isUserDefined())
							oIsInUse(i,n) = CStr(oStyle.isInUse())
							'	oGPS(i,n) = CStr(oStyle.getParentStyle()) : print oStyle.getParentStyle()
							if i = 0 or i = 1 then
								oDisplayName(i,n) = CStr(oStyle.DisplayName)	:	print oDisplayName(i,n) & "i=" & i &"n=" & n & "  " & oOutName(i,n)
								if i = 0 then
									oIsPhysical(i,n) = CStr(oStyle.IsPhysical)					'Not to use for Calc,Draw and Impress
								End If
							End if
					next n			
			oDoc.dispose
		next i
		'出力先file起動
			oDefineFile = ConvertToUrl("c:\temp\Macro_StyleDefined.ods")
			oDefFile_Calc = StarDesktop.loadComponentFromURL(oDefineFile, "_blank", 0, Dummy())
			'Style名の出力
				'Calc fileへAccess
					oController = oDefFile_Calc.getCurrentController()
				'SheetへAccess					
					oSheets = oDefFile_Calc.getSheets()
					for i = 0 to 3
						oTitleCell = oDefFile_Calc.Sheets(i).getCellByPosition(0, 0)
							oTitleCell.String = "Object Methods Defined in the com.sun.star.style.Style service" 
			 					oTitleCell.CharHeight=22
			 					oTitleCell.CharHeightAsian=22
						''Writer,Calc,Draw or Impress
						Select case i
							case =0
								oDefFile_Calc.Sheets(i).getCellByPosition(0, 1).String = "Writer"
							case =1
								oDefFile_Calc.Sheets(i).getCellByPosition(0, 1).String = "Calc"
							case =2
								oDefFile_Calc.Sheets(i).getCellByPosition(0, 1).String = "Draw"
							case =3
								oDefFile_Calc.Sheets(i).getCellByPosition(0, 1).String = "Impress"
						End select 
						'Method名の出力
							oDefFile_Calc.Sheets(i).getCellByPosition(1, 2).String = "isUserDefined()"
							oDefFile_Calc.Sheets(i).getCellByPosition(2, 2).String = "isInUse()"
							oDefFile_Calc.Sheets(i).getCellByPosition(3, 2).String = "DisplayName"
							oDefFile_Calc.Sheets(i).getCellByPosition(4, 2).String = "IsPhysical"
							for n = 0 to oCount(i)
								oDefFile_Calc.Sheets(i).getCellByPosition(0, n + 3).String = oOutName(i,n)
								oDefFile_Calc.Sheets(i).getCellByPosition(1, n + 3).String = oIsUserDefined(i,n)
								oDefFile_Calc.Sheets(i).getCellByPosition(2, n + 3).String = oIsInUse(i,n)
								oDefFile_Calc.Sheets(i).getCellByPosition(3, n + 3).String = oDisplayName(i,n)
								If i = 0 then 
									oDefFile_Calc.Sheets(i).getCellByPosition(4, n + 3).String = oIsPhysical(i,n)
								End If
							next n
						next i
		msgBox("Success")
End Sub

GS-10)[General]DefaultのPage Style名とPage Size取得(XStyleFamiliesSuppliier)[Writer,Calc]


Sub oPrintPageInfo
	Dim OOo as String
	Dim Dummy()
		'Component Lock(Macro実行の体感速度が速くなる)
			oDisplay = ThisComponent
			oDisplay.lockControllers()
		'New Document
		for  n = 0 to 1
			Select Case n
				case =0
					OOo = "writer"
					OOoFile = "private:factory/s" & OOo
				case =1	
					OOo = "calc"
					OOoFile = "private:factory/s" & OOo
			End Select
			oDoc = StarDesktop.loadComponentFromURL(OOoFile, "_blank", 0, Dummy())
				Dim oPageStyle
				Dim oTmpPageStyle
				Dim oStyle
				Dim oPageSize
				Dim pHeight as Long			'	unit : 1/100 mm
				Dim pWidth as Long			'	unit : 1/100 mm
					Select Case OOo
						case "writer"
							'Page Style
								Dim oViewCusor
									oViewCursor = oDoc.CurrentController.getViewCursor()
									oTmpPageStyle = oViewCursor.PageStyleName
									oPageStyle = "PageStyle :  " & oTmpPageStyle
								Msgbox(oPageStyle, 0, "Page Style in Writer")
							'Page Size								
									oStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oTmpPageStyle)
									pHeight = oStyle.height/100		
									pWidth =oStyle.width/100
									oPageSize = "[ PageSize ]" & Chr$(10) & "Height : " &  pHeight & " mm" & Chr$(10) & "Width : " & pWidth & " mm"
								Msgbox(oPageSize, 0, "Page Size in Writer")
							'Page Margin
								Dim oTopMgn as Double
								Dim oBottomMgn as Double
								Dim oLeftMgn as Double
								Dim oRightMgn as Double
									oTopMgn = oStyle.TopMargin / 100						'Top
									oBottomMgn = oStyle.BottomMargin / 100			'Bottom
									oLeftMgn = oStyle.LeftMargin / 100					'Left
									oRightMgn = oStyle.RightMargin / 100					'Right
									oMgn = "[ Margin ]" & Chr$(10) & "Top : " & oTopMgn & " mm" & Chr$(10) & "Bottom : " & oBottomMgn & " mm" & Chr$(10) _
																			& "Left : " & oLeftMgn & " mm" & Chr$(10) & "Right : " & oRightMgn & " mm"
								MsgBox(oMgn, 0, "Margin in Current Page")
							'Charactor Size
								Dim oCharHeight as Double
									oCharHeight = oViewCursor.CharHeight
								MsgBox("Charactor Size : " & oCharHeight & " mm", 0, "Charactor Size in Writer")
							'Page No.
								Dim oCurPage as Integer
									oCurPage = oViewCursor.getPage()			'Page Number
								MsgBox("Current PageNo. is " & oCurPage & " page", 0, "Curent Page No. in Writer")
							'Cursor Position
								Dim oCursorPos
								Dim oXPos  as Double
								Dim oYPos  as Double
									oCursorPos = oViewCursor.getPosition()
										oYPos = oCursorPos.y/100 + oTopMgn + oCharHeight/2
										oXPos = oCursorPos.x/100 + oLeftMgn
										oCurPosition = "[ Current Cursor Position ]" & Chr$(10) & Format(oYPos, "#0.##") & " mm From Top" _
																									& Chr$(10) & Format(oXPos, "#0.##") & " mm From Left"
									MsgBox(oCurPosition, 0, "Current Cursor Postion in Writer")
						case "calc"
							'Page Style
								Dim oSheetStyle
									oSheetStyle = oDoc.getCurrentController.getActiveSheet().PageStyle									
								Msgbox("PageStyle : " & oSheetStyle, 0, "Page Style in Calc")
							'Page Size
								Dim oSheet
								oPageSize = "[ Page Size ]" & Chr$(10)
									oStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oSheetStyle)
									pHeight = oStyle.height/100		
									pWidth =oStyle.width/100
									oPageSize = oPageSize & " Height : " &  pHeight & " mm" & Chr$(10) & " Width : " & pWidth & " mm"
								Msgbox(oPageSize, 0, "Page Size in Calc")
							'Charactor Size								
									oCharHeight = oDoc.getCurrentController.getActiveSheet().CharHeight
								MsgBox("Charactor Size : " & oCharHeight & " mm", 0, "Charactor Size in Calc")
					End Select
				oDoc.dispose
			next n
		oDisplay.unlockControllers()
	msgbox("Success")
End Sub

GS-)[General]「 Page Style 」Dialog表示



Sub PageStyleDialog()
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	  oFrame = ThisComponent.CurrentController.Frame
	  oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	  '
	  oDispatcher.executeDispatch(oFrame,  ".uno:PageFormatDialog", "", 0, oProp())
	msgbox "Success",0,"Page Style Dialogの表示"
End Sub

GS-)[General]Defaut書式にReset


Sub ResetDefaultStyle()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:ResetAttributes", "", 0, Array())
		msgbox "Success"
End Sub
'
' [ Note ]
' 書式 → 直接設定した書式の解除( Layout → Defaultの書式設定 )

GS-)[General]

[ Header / Footer ]

GSHF-)[General]Header、Footerの設定



Sub oHeader_Footer
	Dim oDoc As Object
	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
     	oPageStyles = oDoc.StyleFamilies.getByName("PageStyles")
   		oDefault = oPageStyles.getByName("Default")
   		'Set Header
   			oDefault.HeaderIsOn = true
   			oHeader = oDefault.RightPageHeaderContent
   			oHeader.CenterText.String = "ヘッダー文"
   			oDefault.RightPageHeaderContent = oHeader
    	'Set Fotter
   			oDefault.FooterIsOn = true
   			oFooter = oDefault.RightPageFooterContent
   			oFooter.CenterText.String = "フッター文"
   			oDefault.RightPageFooterContent = oFooter
   		' Value
   		Dim oSheet
   		DIm oCell
   		 oSheet = oDoc.getSheets().GetByIndex(0)
   		 oCell = oSheet.getCellByPosition(0,0)
   		 oCell.String = "Macro Test" 
End Sub

GSHF-)[General]Header、Footerの設定()


Sub oHeaderFooter
  	Dim oDoc
  	Dim oName$
  	Dim oStyle
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  		oName = oDoc.getCurrentController().getViewCursor().PageStyleName
  		oStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oName)
  	'Header 編集Modeにする
    	oStyle.HeaderIsOn = true
    'Header 編集ModeをOFFにする
    	oStyle.HeaderIsOn = false
    'Footer 編集Modeにする
    	oStyle.FooterIsOn = true
    'Footer 編集ModeをOFFにする
    	oStyle.FooterIsOn = false
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

GSHF-)[General]

[ Font ]

GSF-)[General]Font Wieght Name


THIN 		⇒	specifies a 50% font weight.
ULTRALIGHT 	⇒	specifies a 60% font weight.
LIGHT		⇒	specifies a 75% font weight.
SEMILIGHT	⇒	specifies a 90% font weight.
NORMAL		⇒	specifies a normal font weight.
SEMIBOLD	⇒	specifies a 110% font weight.
BOLD		⇒	specifies a 150% font weight.
ULTRABOLD	⇒	specifies a 175% font weight.
BLACK		⇒	specifies a 200% font weight.

GSF-)[General]Default Fontの変更


Sub oChangeDefaultFont()
	Dim nodeArgs(0) As New com.sun.star.beans.PropertyValue
	Dim oService$
	'Properties
		nodeArgs(0).Name = "nodePath"
		nodeArgs(0).Value = "org.openoffice.Office.Writer/DefaultFont"
		nodeArgs(0).State = com.sun.star.beans.PropertyState.DEFAULT_VALUE
		nodeArgs(0).Handle = -1 'no handle!
	'the required Config Services
		oService1 = "com.sun.star.comp.configuration.ConfigurationProvider"
  		oProvider = createUnoService(oService1)
		oService2 = "com.sun.star.configuration.ConfigurationUpdateAccess"
		UpdateAccess = oProvider.createInstanceWithArguments(oService2, nodeArgs())
	'set your DefaultFont now..
		UpdateAccess.Standard = "Arial"
		UpdateAccess.Heading = "Arial"
		UpdateAccess.List = "Arial"
		UpdateAccess.Caption = "Arial"
		UpdateAccess.Index = "Arial"
		UpdateAccess.commitChanges()
End Sub

GFIPs-)[General]日本語Font Name取得

GFIPs-)[General]英数Font Name取得

GFIPs-)[General]英数Font Style設定(Calc)


Sub GnlFont()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim Dummy() 
	Dim oDispatcher as Object
	Dim oProp(4) as new com.sun.star.beans.PropertyValue
		'
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
  		oSheet = oDoc.getSheets().getByName("sheet1")
  		oCell = oSheet.getCellRangeByName("A1")
		oCell.String = "LibreOffficeです"
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' 英数Font Style
			oProp(0).Name = "CharFontName.StyleName"
			oProp(0).Value = "Book"
			oProp(1).Name = "CharFontName.Pitch"
			oProp(1).Value = 2
			oProp(2).Name = "CharFontName.CharSet"
			oProp(2).Value = -1
			oProp(3).Name = "CharFontName.Family"
			oProp(3).Value = 5
			oProp(4).Name = "CharFontName.FamilyName"
			oProp(4).Value = "DejaVu Sans"
		oDispatcher.executeDispatch(oFrame, ".uno:CharFontName", "", 0, oProp())
		'
		' Asian Font Styleの設定不可		' ←英数設定と同じになる
		Rem	oProp(0).Name = "CharFontNameCJK.StyleName"
		Rem	oProp(0).Value = "太字斜体"
		Rem	oProp(1).Name = "CharFontNameCJK.Pitch"
		Rem	oProp(1).Value = 2
		Rem	oProp(2).Name = "CharFontNameCJK.CharSet"
		Rem	oProp(2).Value = -1
		Rem	oProp(3).Name = "CharFontNameCJK.Family"
		Rem	oProp(3).Value = 2
		Rem	oProp(4).Name = "CharFontNameCJK.FamilyName"
		Rem	oProp(4).Value = "Arial Unicode MS"
		Rem oDispatcher.executeDispatch(oFrame, ".uno:CharFontNameCJK", "", 0, oProp())
End Sub

GFIPs-)[General]Font Style設定(Writer)


Sub GnlFont()
	Dim oDoc As Object, oText As Object, oCur as Object
	Dim oCtrl as Object, oFrame as Object
	Dim Dummy() 
	Dim oDispatcher as Object
	Dim oProp(4) as new com.sun.star.beans.PropertyValue
		'
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  		oText = oDoc.getText()
		oCur = oText.createTextCursor
		' 
		oCur.gotoStart(false)
		oCur.setString("LibreOffice と Apache OpenOfficeです。")
		'
		' Docment文字を選択する
		oCtrl = oDoc.getCurrentController()
		oCtrl.select(oText)
		'
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' 英数Font Style
			oProp(0).Name = "CharFontName.StyleName"
			oProp(0).Value = "Book"
			oProp(1).Name = "CharFontName.Pitch"
			oProp(1).Value = 2
			oProp(2).Name = "CharFontName.CharSet"
			oProp(2).Value = -1
			oProp(3).Name = "CharFontName.Family"
			oProp(3).Value = 5
			oProp(4).Name = "CharFontName.FamilyName"
			oProp(4).Value = "DejaVu Sans"
		oDispatcher.executeDispatch(oFrame, ".uno:CharFontName", "", 0, oProp())
		'
		' Asian Font Styleの設定 / Writerの選択範囲では設定OK
			oProp(0).Name = "CharFontNameCJK.StyleName"
			oProp(0).Value = "太字斜体"
			oProp(1).Name = "CharFontNameCJK.Pitch"
			oProp(1).Value = 2
			oProp(2).Name = "CharFontNameCJK.CharSet"
			oProp(2).Value = -1
			oProp(3).Name = "CharFontNameCJK.Family"
			oProp(3).Value = 2
			oProp(4).Name = "CharFontNameCJK.FamilyName"
			oProp(4).Value = "Arial Unicode MS"
		oDispatcher.executeDispatch(oFrame, ".uno:CharFontNameCJK", "", 0, oProp())
End Sub

GFIPs-)[General]英数Font Size設定(Calc)


Sub GnlFont()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim Dummy() 
	Dim oDispatcher as Object
	Dim oProp(2) as new com.sun.star.beans.PropertyValue
		'
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
  		oSheet = oDoc.getSheets().getByName("sheet1")
  		oCell = oSheet.getCellRangeByName("A1")
		oCell.String = "LibreOffficeです"
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' 英数Font
			oProp(0).Name = "FontHeight.Height"
			oProp(0).Value = 15
			oProp(1).Name = "FontHeight.Prop"
			oProp(1).Value = 100
			oProp(2).Name = "FontHeight.Diff"
			oProp(2).Value = 0
		oDispatcher.executeDispatch(oFrame, ".uno:FontHeight", "", 0, oProp())
		'
		' Asian Font Sizeの設定不可		' ←英数設定と同じになる
		Rem	oProp(0).Name = "FontHeightCJK.Height"
		Rem	oProp(0).Value = 26
		Rem	oProp(1).Name = "FontHeightCJK.Prop"
		Rem	oProp(1).Value = 100
		Rem	oProp(2).Name = "FontHeightCJK.Diff"
		Rem	oProp(2).Value = 0
		Rem oDispatcher.executeDispatch(oFrame, ".uno:FontHeightCJK", "", 0, oProp())
End Sub

GFIPs-)[General]Font Size設定(Writer)


Sub GnlFont()
	Dim oDoc As Object, oText As Object, oCur as Object
	Dim oCtrl as Object, oFrame as Object
	Dim Dummy() 
	Dim oDispatcher as Object
	Dim oProp(4) as new com.sun.star.beans.PropertyValue
		'
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  		oText = oDoc.getText()
		oCur = oText.createTextCursor
		' 
		oCur.gotoStart(false)
		oCur.setString("LibreOffice と Apache OpenOfficeです。")
		'
		' Docment文字を選択する
		oCtrl = oDoc.getCurrentController()
		oCtrl.select(oText)
		'
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' 英数Font
			oProp(0).Name = "FontHeight.Height"
			oProp(0).Value = 15
			oProp(1).Name = "FontHeight.Prop"
			oProp(1).Value = 100
			oProp(2).Name = "FontHeight.Diff"
			oProp(2).Value = 0
		oDispatcher.executeDispatch(oFrame, ".uno:FontHeight", "", 0, oProp())
		'
		' Asian Font Sizeの設定不可 / Writerの選択範囲では設定OK
			oProp(0).Name = "FontHeightCJK.Height"
			oProp(0).Value = 26
			oProp(1).Name = "FontHeightCJK.Prop"
			oProp(1).Value = 100
			oProp(2).Name = "FontHeightCJK.Diff"
			oProp(2).Value = 0
		oDispatcher.executeDispatch(oFrame, ".uno:FontHeightCJK", "", 0, oProp())
End Sub

GFIPs-)[General]英数Font Type設定(Calc)


Sub GnlFont()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim Dummy() 
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		'
		oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
  		oSheet = oDoc.getSheets().getByName("sheet1")
  		oCell = oSheet.getCellRangeByName("A1")
		oCell.String = "LibreOffficeです"
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' 英数Font Type
			oProp(0).Name = "Italic"
			oProp(0).Value = true
		oDispatcher.executeDispatch(oFrame, ".uno:Italic", "", 0, oProp())
		'
		' Asian Font Typeの設定不可		' ←英数設定と同じになる
		Rem	oProp(0).Name = "BoldCJK"
		Rem	oProp(0).Value = true
		Rem oDispatcher.executeDispatch(oFrame, ".uno:BoldCJK", "", 0, oProp())
End Sub

GFIPs-)[General]Font Type設定(Writer)


Sub GnlFont()
	Dim oDoc As Object, oText As Object, oCur as Object
	Dim oCtrl as Object, oFrame as Object
	Dim Dummy() 
	Dim oDispatcher as Object
	Dim oProp(4) as new com.sun.star.beans.PropertyValue
		'
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  		oText = oDoc.getText()
		oCur = oText.createTextCursor
		' 
		oCur.gotoStart(false)
		oCur.setString("LibreOffice と Apache OpenOfficeです。")
		'
		' Docment文字を選択する
		oCtrl = oDoc.getCurrentController()
		oCtrl.select(oText)
		'
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' 英数Font Type
			oProp(0).Name = "Italic"
			oProp(0).Value = true
		oDispatcher.executeDispatch(oFrame, ".uno:Italic", "", 0, oProp())
		'
		' Asian Font Typeの設定
			' Itaric を　一度　falseにしないと、太字斜体になる
			oProp(0).Name = "ItalicCJK"
			oProp(0).Value = false
		oDispatcher.executeDispatch(oFrame, ".uno:ItalicCJK", "", 0, oProp())
			'
			oProp(0).Name = "BoldCJK"
			oProp(0).Value = true
		oDispatcher.executeDispatch(oFrame, ".uno:BoldCJK", "", 0, oProp())
End Sub

GFIPs-)[General]

[ Color ]

GC-)[General]文字に色をつける


Sub GnFontColor()
	Dim oDoc As Object
	Dim oSheet As Object 
		oDoc=ThisComponent
		oSheet=oDoc.Sheets(0)
		oCell=oSheet.getCellByPosition(1,1)
		oCell.String="Test"
		oCell.CharColor=RGB(255,0,0)
End Sub

GC-)[General]三原色を調べる


Sub oColor()
Dim oColor As Long
	oColor=RGB(255,100,50)
	oRd=Red(oColor)
	oGr=Green(oColor)
	oB=Blue(oColor)
	oRg=QBColor(7)
	msgbox("Red : " & oRd & Chr$(10) & "Green :" & oGr & Chr$(10) & "Blue :" & oB & Chr$(10) & "QBColor : " & oRg)
End Sub

GC-)[General]文字のFont設定Dialog表示


Sub GnUnoColor()
	Dim oDoc As Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		'
		oDoc = ThisComponent
  		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' 
		oDispatcher.executeDispatch(oFrame, ".uno:Color", "", 0, Array())
End Sub

Print / Printer

[ Print Area ]

GPntr-)[General]Print Area定義



Sub PrintArea()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
    Dim oProp(0) as new com.sun.star.beans.PropertyValue
    	oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    		oProp(0).Name = "ToPoint"
    		oProp(0).Value = "A1:B5"
    	oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
    	oDispatcher.executeDispatch(oFrame, ".uno:DefinePrintArea", "", 0, oProp())
    	'
    msgbox "Success"
End Sub
'
' [ Note ]
' Calcでは com.sun.star.sheet.XPrintArea Interface( setPrintArea )を用いても設定出来る
' Calc編 → 印刷操作 → 印刷範囲を設定する。参照

GPntr-)[General]Print Area追加



Sub PrintArea()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
    Dim oProp(0) as new com.sun.star.beans.PropertyValue
    	oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    		oProp(0).Name = "ToPoint"
    		oProp(0).Value = "A1:B5"
    	oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
    	oDispatcher.executeDispatch(oFrame, ".uno:DefinePrintArea", "", 0, oProp())
    	'
    	' Print Area追加
    		oProp(0).Name = "ToPoint"
    		oProp(0).Value = "A9:B10"
    	oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
    	oDispatcher.executeDispatch(oFrame, ".uno:AddPrintArea", "", 0, oProp())
    msgbox "Success"
End Sub

GPntr-)[General]Print Area削除



Sub PrintArea()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
    Dim oProp(0) as new com.sun.star.beans.PropertyValue
    	oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    		oProp(0).Name = "ToPoint"
    		oProp(0).Value = "A1:B5"
    	oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
    	oDispatcher.executeDispatch(oFrame, ".uno:DefinePrintArea", "", 0, oProp())
    	'
    	' Print Area追加
    		oProp(0).Name = "ToPoint"
    		oProp(0).Value = "A9:B10"
    	oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
    	oDispatcher.executeDispatch(oFrame, ".uno:AddPrintArea", "", 0, oProp())
    	'
    	' Print Area削除
    	oDispatcher.executeDispatch(oFrame, ".uno:DeletePrintArea", "", 0, oProp())
    msgbox "Success"
End Sub

GPntr-)[General]Print Area変更



Sub PrintArea()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
    Dim oProp(0) as new com.sun.star.beans.PropertyValue
    	oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    		oProp(0).Name = "ToPoint"
    		oProp(0).Value = "A1:B5"
    	oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
    	oDispatcher.executeDispatch(oFrame, ".uno:DefinePrintArea", "", 0, oProp())
    	'
    	msgbox "Defined Print Area",0,"Confirm"
    	'
    		oProp(0).Name = "PrintArea"
    		oProp(0).Value = "A3:B8"
    	oDispatcher.executeDispatch(oFrame, ".uno:ChangePrintArea", "", 0, oProp())	
    	'
    msgbox "Success"
End Sub

GPntr-)[General]

[ Print情報 ]

GPntr-)[General]Printer設定(取得)



Sub oDispPrinterProps()
	Dim oDoc
	Dim OOo
	Dim oDummy()
	Dim oPrtProps
	Dim oPrtPropValue
	Dim oPrtPropName$
	Dim oDisp
	Dim i% as Integer
	Dim n% as Integer
		'On Error Resume Next
		oDisp = "<< Properties : com.sun.star.view.PrinterDescriptor >>" & Chr$(10)
		for n = 0 to 5
			Select case n
				case =0
					OOo = "writer"
				case =1
					OOo = "calc"
				case =2
					OOo = "draw"
				case =3
					OOo = "impress"
				case =4
					OOo = "math"
				case =5
					OOo = "database"
			End Select
			oDisp = oDisp & "[ " & OOo & " ]" & Chr$(10)
		oDoc = StarDesktop.loadComponentFromURL("private:factory/s" & OOo, "_default", 0, oDummy())
		oPrtProps =oDoc.getPrinter()
		'oPrtProps =ThisComponent.getPrinter()
		for i = 0 to UBound(oPrtProps)
			oPrtPropName = oPrtProps(i).Name	':	print oPrtPropName
			oPrtPropValue = oPrtProps(i).Value		':	Print oPrtPropValue
			oDisp = oDisp & oPrtPropName & " = "
			Select case oPrtPropName 
				case "PaperOrientation" 
					oDisp = oDisp & IIf( oPrtPropValue = com.sun.star.view.PaperOrientation.PORTRAIT, "Portrait", "Landscape") & " = " & CStr(oPrtPropValue)
				case "IsBusy"
					oDisp = oDisp & CStr(oPrtPropValue)
				case "PaperFormat"
					Select case oPrtPropValue
						case "com.sun.star.view.PaperFormat.A3"
							oDisp = oDisp & "A3"
						case "com.sun.star.view.PaperFormat.A4"
							oDisp = oDisp & "A4"
						case "com.sun.star.view.PaperFormat.A5"
							oDisp = oDisp & "A5"
						case "com.sun.star.view.PaperFormat.B4"
							oDisp = oDisp & "B4"
						case "com.sun.star.view.PaperFormat.B5"
							oDisp = oDisp & "B5"
						case "com.sun.star.view.PaperFormat.LETTER"
							oDisp = oDisp & "LETTER"
						case "com.sun.star.view.PaperFormat.LEGAL"
							oDisp = oDisp & "LEGAL"
						case "com.sun.star.view.PaperFormat.TABLOID"
							oDisp = oDisp & "TABLOID"
						case "com.sun.star.view.PaperFormat.USER"
							oDisp = oDisp & "USER"
						case Else
							oDisp = oDisp & CStr(oPrtPropValue)
					End Select					
				case "PaperSize"
					If NOT IsEmpty(oPrtPropValue) then
						oDisp = oDisp & CDbl(oPrtPropValue.Width)/(100*0.57) & " * " & CDbl(oPrtPropValue.Height)/(100*0.57) & " mm"
					else
						oDisp = oDisp & "No Data"
					End If
				case Else
					oDisp = oDisp & CStr(oPrtPropValue) 
			End Select
			oDisp = oDisp & Chr$(10)			
		next i
		oDoc.close(true)
		oDisp = oDisp & Chr$(10)
		next n
		MsgBox(oDisp, 0, "Printer Properties")
End Sub

GPntr-)[General]Printer情報取得(Less Base)[ Printer / getPrinter() ][ com.sun.star.view.PrinterDescriptor ]



Sub oDocPrinter()
	Dim oDoc
	Dim OOo
	Dim SufOOo
	Dim oTempName
	Dim oDummy()
	Dim oStoreFile(0)  As New com.sun.star.beans.PropertyValue
	Dim oProp
		oProp = "Printer"
		' Initialize Display
			oDisp = "<< " & oProp & " >>" & Chr$(10) 
			for n= 0 to 4
				Select case n
					case = 0
						OOo = "writer"
						SufOOo = "odt"
					case = 1
						OOo = "calc"
						SufOOo = "ods"
					case = 2
						OOo = "draw"
						SufOOo = "odg"
					case = 3
						OOo = "impress"
						SufOOo = "odp"
					case = 4
						OOo = "math"
						SufOOo = "odf"
				End Select
				oDoc = StarDesktop.loadComponentFromURL("private:factory/s" & OOo , "_blank", 0, oDummy())
				oTempName = ConvertToUrl("c:\temp\oDocProp." & SufOOo)
				oStoreFile(0).Name = "Overwrite"
				oStoreFile(0).Value = true
				oDoc.storeAsURL(oTempName,oStoreFile())
			'Properties [ Array ]
				Dim oArray
				Dim i%
		On Error Resume Next
			oDisp = oDisp & "[  " & OOo & "  ]" & Chr$(10)
			oArray = oDoc.Printer
			for i = 0 to UBound(oArray)
				Select case oArray(i).Name
					case "PaperOrientation"
						oDisp = oDisp & "   " & oArray(i).Name & " = " 
						oDisp = oDisp & IIf( oArray(i).Value = com.sun.star.view.PaperOrientation.PORTRAIT, "Portrait", "Landscape")
						oDisp = oDisp & Chr$(10)
					case "PaperSize"
						oDisp = oDisp & "   " & oArray(i).Name & " = "
						oSize = oArray(i).Value
						oDisp = oDisp & CLng(oSize.Width/100) & " * " & CLng(oSize.Height/100) & " [ mm ] Width × Height"
						oDisp = oDisp & Chr$(10)
					case else
						oDisp = oDisp & "   " & oArray(i).Name & " = " 
						oDisp = oDisp & oArray(i).Value
						oDisp = oDisp & Chr$(10)
				End Select
			next i
			oDisp = oDisp & Chr$(10)
			oDoc.close(true)
				If n > 5 then Exit Sub
			next n
		If oDisp = "<< " & oProp & " >>" & Chr$(10) & "   " then
			oDisp = oDisp & Chr$(10) & "  に関する情報はありません"
		End If
		msgbox(oDisp, 0, oProp & " of Properties" )						
End Sub

GPntr-)[General]Printer設定


Public oDummy(0) as new com.sun.star.beans.PropertyValue
Public oOpts(1) as new com.sun.star.beans.PropertyValue
Sub oSetPrinter
	Dim oFileName
	Dim oFileURL$
		oFileName = "c:\temp\Macro_Calc2.ods"
		oFileURL = ConvertToUrl(oFileName)
		If NOT FileExists(oFileURL) then
			MsgBox(oFileName & "が存在しません。", 0, "Caution")
			Exit Sub
		End If
	'Hidden Modeにて起動
	'63 : Readonly
		Dim oDoc
			oDummy(0).Name = "Hidden"
			'oDummy(0).Value = True
			oDummy(0).Value = False
			oDoc =StarDesktop.LoadComponentFromUrl(oFileURL, "_blank", 0, oDummy())
	'Set Properties of the Printer
		Dim oPrtName$
		Dim oPrtPOrn
		Dim oPrtPFmt
		Dim oPrtPropName		
		Dim oPrinter
		Dim oPS as new com.sun.star.awt.Size
			oPrtName = "hp psc 2500 series"		'printer Name
			oPrtPOrn = "com.sun.star.view.PaperOrientation.PORTRAIT"
			oPrtPFmt = "com.sun.star.view.PaperFormat.A4"
			oPS.Height = 21000		'unit : 0.57 * 1/100 mm
			oPS.width =  29700		'unit : 0.57 * 1/100 mm
			oPrinter = oDoc.getPrinter()
		for i = LBound(oPrinter) to LBound(oPrinter)
			oPrtPropName = oPrinter(i).Name
			Select case oPrtPropName
				case "Name"
					oPrinter(i).Value = oPrtName
				case "PaperOrientation"
					'oPrinter(i).Value = oPrtPOrn
					oPrinter(i).Value = 1
				case "PaperFormat"
					oPrinter(i).String = oPrtPFmt
				case "PaperSize"					
					oPrinter(i).Value = oPS
				case "IsBusy"
					If oPrinter(i).Value = True then
						MsgBox("只今Printerは使用中です。設定を中止します。", 0, "Caution")
						Exit Sub
					End If
				case "CanSetPaperOrientation"
					oPrinter(i).Value = True
				case "CanSetPaperFormat"
					oPrinter(i).Value = True
				case "CanSetPaperSize"
					oPrinter(i).Value = True
			End Select
		next i
		oDoc.setPrinter(oPrinter)
	'Store
		Dim oOpt as new com.sun.star.beans.PropertyValue
			oOpt(0).Name = "Overwrite"
			oOpt(0).Value = True
			oDoc.storeAsURL(oFileURL, oOpt())
	'Confirm the Printer Properties
		oPrinter = oDoc.getPrinter()		'改めてデータを取得
		for i = 0 to UBound(oPrinter)
			oPrtPropName = oPrinter(i).Name	:	print oPrtPropName
			oPrtPropValue = oPrinter(i).Value		:	Print oPrtPropValue
			oDisp = oDisp & oPrtPropName & " = "
			Select case oPrtPropName 
				case "PaperOrientation" 
					oDisp = oDisp & IIf( oPrtPropValue = com.sun.star.view.PaperOrientation.PORTRAIT, "Portrait", "Landscape") & " = " & CStr(oPrtPropValue)
				case "IsBusy"
					oDisp = oDisp & CStr(oPrtPropValue)
				case "PaperFormat"
					Select case oPrinter(i).Value
						case "com.sun.star.view.PaperFormat.A3"
							oDisp = oDisp & "A3"
						case "com.sun.star.view.PaperFormat.A4"
							oDisp = oDisp & "A4"
						case "com.sun.star.view.PaperFormat.A5"
							oDisp = oDisp & "A5"
						case "com.sun.star.view.PaperFormat.B4"
							oDisp = oDisp & "B4"
						case "com.sun.star.view.PaperFormat.B5"
							oDisp = oDisp & "B5"
						case "com.sun.star.view.PaperFormat.LETTER"
							oDisp = oDisp & "LETTER"
						case "com.sun.star.view.PaperFormat.LEGAL"
							oDisp = oDisp & "LEGAL"
						case "com.sun.star.view.PaperFormat.TABLOID"
							oDisp = oDisp & "TABLOID"
						case "com.sun.star.view.PaperFormat.USER"
							oDisp = oDisp & "USER"
						case Else
							oDisp = oDisp & CStr(oPrtPropValue)
					End Select					
				case "PaperSize"
					If NOT IsEmpty(oPrtPropValue) then
						oDisp = oDisp & CDbl(oPrtPropValue.Width)/(100) & " * " & CDbl(oPrtPropValue.Height)/(100) & " mm"
					else
						oDisp = oDisp & "No Data"
					End If
				case Else
					oDisp = oDisp & CStr(oPrtPropValue) 
			End Select
			oDisp = oDisp & Chr$(10)
		next i
		oDoc.close(true)
		MsgBox(oDisp, 0, "Confirm the Printer Properties")
End Sub

GPntr-)[General]指定Pageを印刷


`Propperties:com.sun.star.view.PrintOption
Sub oPrintPage
	Dim oProps(1) as new com.sun.star.beans.PropertyValue
		oProps(0).Name = "Pages"
		oProps(0).Value = "0-0"
		ThisComponent.print(oProps())
End Sub

GPntr-)[General]Print部数を設定


`Propperties:com.sun.star.view.PrintOption
Sub oPrintCopyCount
	Dim oProps(0) as new com.sun.star.beans.PropertyValue
		oProps(0).Name = "CopyCount"
		oProps(0).Value = 1
		ThisComponent.print(oProps())
End Sub

GPntr-)[General]Print File名を設定(File出力時)


`Propperties:com.sun.star.view.PrintOption
Sub oPrintFileName
	Dim oProps(0) as new com.sun.star.beans.PropertyValue
		oProps(0).Name = "FileName"
		oProps(0).Value = ConvertToUrl("c:\temp\OOoMacro.txt")
		ThisComponent.print(oProps())
End Sub

GPntr-)[General]Print Pageを揃える


`Propperties:com.sun.star.view.PrintOption
Sub oPrintFileName
	Dim oProps(0) as new com.sun.star.beans.PropertyValue
		oProps(0).Name = "Collate"
		oProps(0).Value = True
		ThisComponent.print(oProps())
End Sub

[ Preview ]

GPPv-)[General]Preview画面


Sub oPrintPeview
	Dim oDoc as Object
	Dim oFrame as Object
		oDoc = ThisComponent
		oFrame = oDoc.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		dispatcher.executeDispatch(oFrame, ".uno:PrintPreview", "", 0, Array())
End Sub

GPPv-)[General]Preview画面を閉じる


Sub oPrintPeview
	Dim oDoc as Object
	Dim oFrame as Object
		oDoc = ThisComponent
		oFrame = oDoc.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		dispatcher.executeDispatch(oFrame, ".uno:PrintPreview", "", 0, Array())
		'
		Wait 3000			' <= 処理待ち時間が少ないとClose出来ない
		'
		dispatcher.executeDispatch(oFrame, ".uno:ClosePreview", "", 0, Array())
		'
End Sub

GPPv-)[General]Preview画面かどうかを判定


Sub oPrintPeview()
	Dim oDoc as Object
	Dim oControl as Object
	Dim oFrame as Object
		oDoc = ThisComponent
		oControl1 = oDoc.CurrentController
		oFrame = oControl1.Frame
		
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		dispatcher.executeDispatch(oFrame, ".uno:PrintPreview", "", 0, Array())
		'
		Wait 3000			' ← 処理待ち時間が少ないとClose出来ない
		'
	Dim oManager as Object
		oManager = CreateUnoService("com.sun.star.frame.ModuleManager")
		'
	Dim oIdentfy as String
	Dim oView as String
	Dim oControl2 as Object
	Dim oIsPreview as Boolean
	Dim oDisp as String
		oIdentfy = oDoc.Identifier
		oView = ""
		Select case oIdentfy
			Case "com.sun.star.text.TextDocument"
				' Witer
				oView = "com.sun.star.view.XViewSettingsSupplier"
			Case "com.sun.star.sheet.SpreadsheetDocument"
				' Calc
				oView = "com.sun.star.sheet.XSpreadsheetView"
			Case else
				oView = ""
		End Select
		'
		If oView <> "" then
			' 現在ContollerのView状態を確認し、Preview Modeを持っていれば標準画面（Previewでは無い）
			oControl2 = oDoc.CurrentController
			oIsPreview = HasUnoInterfaces(oControl2, oView)
			If NOT oIsPreview then
				oAns = msgbox("Preview画面を閉じますか",4,"確認")
				If oAns = 6 then
					dispatcher.executeDispatch(oFrame, ".uno:ClosePreview", "", 0, Array())
				End If
			End If
		else
			oDisp = "本DocumentはWriter または Calcではありません"
			msgbox oDisp,0,"Caution"
			Exit Sub
		End If
End Sub

GPPv-)[General]余白線の表示/非表示


Sub oPrintPeview()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:PrintPreview", "", 0, Array())
		'
		wait 100
		' 余白線 表示/非表示
		oDispatcher.executeDispatch(oFrame, ".uno:Margins", "", 0, Array())
		msgbox "余白線表示",0,"Preview"
		oDispatcher.executeDispatch(oFrame, ".uno:Margins", "", 0, Array())
		msgbox "余白線非表示",0,"Preview"
End Sub

GPPv-)[General]Next Pageへ


Sub oPrintPeview()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:PrintPreview", "", 0, Array())
		'
		wait 300
		' Next Page表示
		oDispatcher.executeDispatch(oFrame, ".uno:NextPage", "", 0, Array())
		msgbox "Next Page表示",0,"Preview"
End Sub

GPPv-)[General]Previous Pageへ


Sub oPrintPeview()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:PrintPreview", "", 0, Array())
		'
		wait 300
		' Change Page
		oDispatcher.executeDispatch(oFrame, ".uno:NextPage", "", 0, Array())
		msgbox "Next Page表示",0,"Preview"
		oDispatcher.executeDispatch(oFrame, ".uno:PreviousPage", "", 0, Array())
		msgbox "Previous Page表示",0,"Preview"
End Sub

GPPv-)[General]Last Pageへ


Sub oPrintPeview()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:PrintPreview", "", 0, Array())
		'
		wait 300
		' Cange Page
		oDispatcher.executeDispatch(oFrame, ".uno:NextPage", "", 0, Array())
		msgbox "Next Page表示",0,"Preview"
		oDispatcher.executeDispatch(oFrame, ".uno:PreviousPage", "", 0, Array())
		msgbox "Previous Page表示",0,"Preview"
		oDispatcher.executeDispatch(oFrame, ".uno:LastPage", "", 0, Array())
		msgbox "Last Page表示",0,"Preview"
End Sub

GPPv-)[General]First Pageへ


Sub oPrintPeview()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:PrintPreview", "", 0, Array())
		'
		wait 500
		' Change Page
		oDispatcher.executeDispatch(oFrame, ".uno:LastPage", "", 0, Array())
		msgbox "Last Page表示",0,"Preview"
		oDispatcher.executeDispatch(oFrame, ".uno:FirstPage", "", 0, Array())
		msgbox "First Page表示",0,"Preview"
End Sub

Macroの杜 (OpenOffice.org/LibreOffice Basic編)

General No.2

###【 Continued from General No.1 】###

**********************【 Index 】**********************

OpenOffice.org / LibreOffice

###【 Following General No.3 】###

**********************【 Macro Code 】**********************

OpenOffice.org / LibreOffice

GOGCp-)[General]ClipboardにCopy

GOGCp-)[General]ClipboardからPaste

GOGCp-)[General]書式設定のCopy / Copy解除

GOGCp-)[General]Clipboardから形式を選択して貼り付け

GMS-)[General]Screen Lock

GMS-)[General]Screen Lock(2)

GMS-)[General]Status Indicator(1)

GMS-)[General]Status Indicator(2)

GMS-)[General]Screen Lock有無確認

GMS-)[General]Subrutine内の位置に飛ぶ / SubrutineからExit

GMS-)[General]Do Loopから抜ける

GMS-)[General]入力値から選択

GME-)[General]Errorを無視/Label行に飛ぶ/Line No.を取得/Error No.を取得/Error Messageの取得

GDCmp-)[General]Document構成Folder/File(Writer/Calc/Impress)

GDCmp-)[General]Document構成Folder/File(Draw/Math/Base)

GDCmp-)[General]

GDC-)[General]Document状態[ ReadOnly ]の確認(com.sun.star.frame.XStorable)

GDC-)[General]Document状態[ 保護 ]の確認

GDC-)[General]Document状態[ 変更されたかどうか ]の確認

GDC-)[General]Document状態[ ControllerLockされているか ]の確認

GDL-)[General]Templateとして起動

GDL-)[General]画面に表示せずに起動

GDL-)[General]新規Viewにて起動せず

GDL-)[General]Preview Modeにて起動

GDL-)[General]ReadOnlyとして起動

GDL-)[General]Macroの実行不許可

GDL-)[General]CSV Fileを読み込み

GDL-)[General]DialogからFile選択

GDS-)[General]PDF Fileに出力

GDS-)[General]Optionを付けてPDF出力

GDS-)[General]Hbrid PDF作成

GDS-)[General]上書き保存

GDS-)[General]

GDS-)[General]Templateとして保存

GDS-)[General]画像dataを圧縮せずに保存

GDS-)[General]Documentの強制終了

GDS-)[General]Documentの安全なClose

GFS-)[General]Store可能形式取得

GDS-)[General]fileがDisk内に既保存の判定と既保存時のfile名取得(com.sun.star.frame.XStorable)

GDS-)[General]file保存(上書き保存)(com.sun.star.frame.XStorable)

GDS-)[General]名前を付けて保存(編集fileは新しいfile(macro1(writer).odt)になる)(com.sun.star.frame.XStorable)

GDS-)[General]名前を付けて保存(編集fileは現在編集中のfileのまま)(com.sun.star.frame.XStorable)

GDS-)[General]MS-Office2003形式で保存(com.sun.star.frame.XStorable)

GDS-)[General]文書の保存確認Dialogの表示(変更がある場合)

GDSel-)[General]現在のFrameをActivate(1)

GDSel-)[General]現在のFrameをActivate(2)) / 最前Windowにする

GDSel-)[General]Selection Areaを数える

GDSel-)[General]全て選択

GDSelMd-)[General]Default( Writer )

GDSelMd-)[General]Block選択( Writer )

GDSelMd-)[General]次の選択Modeへ変更[ 拡張、拡張 ]( Writer )

GDSelMd-)[General]Default選択( Calc )

GDSelMd-)[General]拡張選択( Calc )

GDSelMd-)[General]追加選択( Calc )

GDSelMd-)[General]

GDUdMg-)[General]直前の編集を元に戻す(1)

GDUdMg-)[General]直前の編集を元に戻す(2)

GDUdMg-)[General]直前の編集をやり直す(1)

GDUdMg-)[General]直前の編集をやり直す(2)

GDUdMg-)[General]直前の編集を繰り返し

GDUdMg-)[General]任意の編集( UndoContext )を元に戻す

GDUdMg-)[General]任意の編集( UndoContext )をやり直す

GDUdMg-)[General]Current UndoのTitle取得

GDUdMg-)[General]Current RedoのTitle取得

GDUdMg-)[General]全てのUndo Title取得

GDUdMg-)[General]全てのRedo Title取得

GDUdMg-)[General]Undo / RedoのClear

GDUdMg-)[General]RedoのみClear

GDUdMg-)[General]UndoManagerのLock/Unlock(未完成)

GDUdMg-)[General]UndoManagerのReset

GDUdMg-)[General]

GDUdMg-)[General]

Macroの杜
(OpenOffice.org/LibreOffice Basic編)

【 Index 】

【 Macro Code 】

GDp-)[General]「ユーザーデータ使用する」Check ON/OFF

GDp-)[General]「元に戻す( Reset ) 」Button Click(1)