Sub CopyPaste()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
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, Array())
msgbox "Success"
End Sub
Sub CopyPaste()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
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, Array())
msgbox "Success"
End Sub
Sub CopyPaste()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
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, Array())
' 書式設定のCopy解除
oDispatcher.executeDispatch(oFrame, ".uno:FormatPaintbrush", "", 0, Array())
End Sub
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編参照
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
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
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
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
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
Sub oError
Dim oExcpt as Object
Dim oE as Long
GlobalScope.BasicLibraries.LoadLibrary("ScriptForge")
oExcpt = CreateScriptService("Exception")
'
On Error Goto oBad
oE=1/CInt(0.2)
'
Exit Sub
oBad:
'例外発生 : oExcpt.Raise(Error Number, Error Line ,Description)
oExcpt.Raise(Err, Erl, Error)
End Sub
'
'Note
' CreateScriptService("Exception") は SF_Exception でもOK
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
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
Sub StorewithName()
Dim oFactory as Object
Dim oSuppoertedFile() as String
Dim oDisp as String
oFactory = createUnoService("com.sun.star.document.FilterFactory")
oSuppoertedFile = oFactory.AvailableServiceNames
oDisp = "[ SupportされるFile形式(1/2) ]"
for i = 0 to CInt(UBound(oSuppoertedFile) /2)
oDisp = oDisp & Chr$(10) & oSuppoertedFile(i)
next i
msgbox oDisp,0,"Supported File"
'
oDisp = "[ SupportされるFile形式(2/2) ]"
for i = CInt(UBound(oSuppoertedFile) /2) +1 to UBound(oSuppoertedFile)
oDisp = oDisp & Chr$(10) & oSuppoertedFile(i)
next i
msgbox oDisp,0,"Supported File"
End Sub
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
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
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
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
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
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.
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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 で取り消した操作を再度やり直す
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
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
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
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
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
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
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
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
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
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
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, 15 )
End Sub
'
Note
x,y,Width,Hight,Flagで設定する。
Flagを変更すると、位置のみ、Sizeのみにもできる。
com::sun::star::awt::PosSize Constant Group
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
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
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
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
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
Sub oDisplayFrame
Dim oAllFrame As Variant
Dim oFrame As Variant
Dim oCount As Integer
Dim i As Integer
Dim oDisp As String
'Get all of the frames
oAllFrame = StarDesktop.getFrames
oCount = oAllFrame.getCount()
oDisp = "【 Frame Title 】"
for i =0 to oCount-1
oFrame = oAllFrame.getByIndex(i)
oDisp = oDisp & chr$(10) & oFrame.title
next
msgbox(oDisp,0,"LO7.5.7.1")
End Sub
Sub DisplayFrame()
GlobalScope.BasicLibraries.LoadLibrary("ScriptForge")
Dim ui As Variant
Dim openDocs as Object
Dim oDisp as String
Set ui = CreateScriptService("UI")
Set openDocs = ui.Documents()
oDisp = "【 Frame Title 】"
For i = 0 to UBound(openDocs)
oDisp = oDisp & Chr$(10) & openDocs(i)
Next i
msgbox(oDisp,0,"LO7.5.7.1")
End Sub
'
'【Note】
'getFrames Methodを利用する場合とは異なり、Docmentの種類は取得されない。
'また、MacroのIDEのFrameも取得されない。
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
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
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
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
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
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
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
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
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
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
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
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
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
' 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 だと思います。
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
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
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
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
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
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
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
Sub UserDataReset()
Dim oDoc as Object
Dim oDocProp as Object
oDoc = ThisComponent
oDocProp = oDoc.getDocumentProperties()
oDocProp.resetUserData("UseUserData")
'
msgbox "Success"
End Sub
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
Sub oXStyleFamiliesSupplier1
Dim oFamilies
Dim oFamilyNames
Dim oNumStyle
oFamilies = ThisComponent.StyleFamilies
oFamilyNames = oFamilies.getElementNames()
oNumStyle = UBound(oFamilyNames)+1
msgBox("本fileにて使用可能なStyleType数は ： " & oNumStyle & " 種類です。")
End Sub
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
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
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
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
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の書式設定 )
Sub UnoStyleList()
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")
' Show the window of Style and Format / スタイルと書式設定のWindow表示
oProp(0).Name = "DesignerDialog"
oProp(0).Value = true
oDispatcher.executeDispatch(oFrame, ".uno:DesignerDialog", "", 0, oProp())
msgbox "Show the window" & Chr$(10) & "( DispatchHelper )"
'
' Unshow the window of Style and Format / スタイルと書式設定のWindow非表示
oProp(0).Name = "DesignerDialog"
oProp(0).Value = false
oDispatcher.executeDispatch(oFrame, ".uno:DesignerDialog", "", 0, oProp())
msgbox "Unshow the window" & Chr$(10) & "( DispatchHelper )"
End Sub
'
' [ Note ]
' oDispatcher.executeDispatch(oFrame, ".uno:EditStyle", "", 0, Array())
' では、「スタイルと書式設定」Windowが表示される。
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.
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
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
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
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
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
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
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
`Propperties:com.sun.star.view.PrintOptions
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
`Propperties:com.sun.star.view.PrintOptions
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
`Propperties:com.sun.star.view.PrintOptions
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
`Propperties:com.sun.star.view.PrintOptions
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
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
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
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
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
Sub oError
Dim oExcpt as Object
Dim oE as Long
GlobalScope.BasicLibraries.LoadLibrary("ScriptForge")
oExcpt = CreateScriptService("Exception")
'
On Error Goto oBad
oE=1/CInt(0.2)
'
Exit Sub
oBad:
'例外発生 : oExcpt.Raise(Error Number, Error Line ,Description)
oExcpt.Raise(Err, Erl, Error)
End Sub
'
'Note
' CreateScriptService("Exception") は SF_Exception でもOK
'Note : ScriptForge Libraryは LO ver7.2から有効
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
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
Sub StorewithName()
Dim oFactory as Object
Dim oSuppoertedFile() as String
Dim oDisp as String
oFactory = createUnoService("com.sun.star.document.FilterFactory")
oSuppoertedFile = oFactory.AvailableServiceNames
oDisp = "[ SupportされるFile形式(1/2) ]"
for i = 0 to CInt(UBound(oSuppoertedFile) /2)
oDisp = oDisp & Chr$(10) & oSuppoertedFile(i)
next i
msgbox oDisp,0,"Supported File"
'
oDisp = "[ SupportされるFile形式(2/2) ]"
for i = CInt(UBound(oSuppoertedFile) /2) +1 to UBound(oSuppoertedFile)
oDisp = oDisp & Chr$(10) & oSuppoertedFile(i)
next i
msgbox oDisp,0,"Supported File"
End Sub
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
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
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
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
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
Sub DocStore()
Dim oDoc as Object, oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oCtrl.suspend( true )
End Sub
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
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
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から変更しない模様
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
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
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
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
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
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 で取り消した操作を再度やり直す
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
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
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
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
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
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
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
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
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
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
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も初期化
Sub oDisplayFrame
Dim oAllFrame As Variant
Dim oFrame As Variant
Dim oCount As Integer
Dim i As Integer
Dim oDisp As String
'Get all of the frames
oAllFrame = StarDesktop.getFrames
oCount = oAllFrame.getCount()
oDisp = "【 Frame Title 】"
for i =0 to oCount-1
oFrame = oAllFrame.getByIndex(i)
oDisp = oDisp & chr$(10) & oFrame.title
next
msgbox(oDisp,0,"LO7.5.7.1")
End Sub
Sub DisplayFrame()
GlobalScope.BasicLibraries.LoadLibrary("ScriptForge")
Dim ui As Variant
Dim openDocs as Object
Dim oDisp as String
Set ui = CreateScriptService("UI")
Set openDocs = ui.Documents()
oDisp = "【 Frame Title 】"
For i = 0 to UBound(openDocs)
oDisp = oDisp & Chr$(10) & openDocs(i)
Next i
msgbox(oDisp,0,"LO7.5.7.1")
End Sub
'
'【Note】
'getFrames Methodを利用する場合とは異なり、Docmentの種類は取得されない。
'また、MacroのIDEのFrameも取得されない。
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
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
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
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
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
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
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
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
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
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
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
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
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
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
' 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 だと思います。
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
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
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
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
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
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
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
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
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
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
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
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
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
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
'
' [ Note ]
' 本機能は com.sun.star.sheet.SpreadsheetDocumentSettings Service である。Calc ⇒ Document Setting 参照
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
'
' [ Note ]
' 本機能は com.sun.star.sheet.SpreadsheetDocumentSettings Service である。Calc ⇒ Document Setting 参照
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
Sub test_UserProfileData
'Look at file <
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
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
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
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
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
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
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
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
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
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
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
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
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
Sub UnoStyleList()
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")
' Show the window of Style and Format / スタイルと書式設定のWindow表示
oProp(0).Name = "DesignerDialog"
oProp(0).Value = true
oDispatcher.executeDispatch(oFrame, ".uno:DesignerDialog", "", 0, oProp())
msgbox "Show the window" & Chr$(10) & "( DispatchHelper )"
'
' Unshow the window of Style and Format / スタイルと書式設定のWindow非表示
oProp(0).Name = "DesignerDialog"
oProp(0).Value = false
oDispatcher.executeDispatch(oFrame, ".uno:DesignerDialog", "", 0, oProp())
msgbox "Unshow the window" & Chr$(10) & "( DispatchHelper )"
End Sub
'
' [ Note ]
' oDispatcher.executeDispatch(oFrame, ".uno:EditStyle", "", 0, Array())
' では、「スタイルと書式設定」Windowが表示される。
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
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編 → 印刷操作 → 印刷範囲を設定する。参照
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
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
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
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
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