Home of site
Macroの杜
(OpenOffice.org/LibreOffice Basic編)
Writer No.2
**********************【 Index 】**********************
Search/Replace
Table[Writer]
Style
[ CharacterStyles ]
[ ParagraphStyles ]
[ Tab Stop ]
[ PageStyles ]
[ NumberingStyles ]
HyperLink[Writer]
[ BookMark ]
[ Index ]
[ HyperLink ]
Outline(箇条書き)
Sort
Printer
Shape[Writer]
Form
Draw[Writer]
DateTime[Writer]
Annotation(注釈)[Writer]
View[ com.sun.star.text.ViewSettings( LibreOffice / Apache OpenOffice )] // [ com.sun.star.view.ViewSettings( LibreOffice / Apache OpenOffice )]
**********************【 Macro Code 】**********************
Search/Replace
WSR-)[Writer]Simple Search & Replace(1)
Sub oWriterStyle
Dim oDoc
Dim oWText
Dim oString
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
'
Dim oDescriptor
Dim oFound
oDescriptor = oDoc.createSearchDescriptor()
'
With oDescriptor
.SearchString = "This"
.SearchWords = true ' 完全一致の文字か?
.SearchCaseSensitive = False ' 大文字と小文字を区別するか?
End With
'
oFound = oDoc.findFirst(oDescriptor)
nn = 1
Do While Not IsNull(oFound) and nn<1000
oFound.CharWeight = com.sun.star.awt.FontWeight.BOLD
oFound = oDoc.findNext( oFound.End, oDescriptor)
Loop
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WSR-)[Writer]Simple Search & Replace(2)
Sub oWriterSearchRepalce
Dim oDoc
Dim oWText
Dim oString
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
'
Dim oDescriptor
Dim oFound
Dim oFoundAll
oDescriptor = oDoc.createSearchDescriptor()
'
With oDescriptor
.SearchString = "This"
.SearchWords = true ' 完全一致の文字か?
.SearchCaseSensitive = False ' 大文字と小文字を区別するか?
End With
'
oFoundAll = oDoc.findAll(oDescriptor)
for i = o to oFoundAll.getCount()-1
oFound = oFoundAll.getByIndex(i)
Print oFound.getString()
oFound.setString("THIS")
next i
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WSR-)[Writer]複数のWordの置換
Sub oWriterSearchReplace
Dim oDoc
Dim oWText
Dim oString
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
'
Dim oReplace
Dim oFound
Dim oSearchWord(2) As String
Dim oReplaceWord(2) As String
Dim n as long
oSearchWord(0) = "writer"
oSearchWord(1) = "line"
oSearchWord(2) = "paragraph"
'
oReplaceWord(0) = "WRITER"
oReplaceWord(1) = "LINE"
oReplaceWord(2) = "PARAGRAPH"
'
oReplace = oDoc.createReplaceDescriptor()
oReplace.SearchCaseSensitive = True
For n = LBound(oSearchWord()) To UBound(oReplaceWord())
oReplace.SearchString = oSearchWord(n)
oReplace.ReplaceString = oReplaceWord(n)
oDoc.ReplaceAll(oReplace)
Next n
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WSR-)[Writer]正規表現( とにかくなんでもいい１文字 )
Sub oWriterSearchRepalce
Dim oDoc
Dim oWText
Dim oString
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
'
Dim oDescriptor
Dim oFound
Dim oFoundAll
oDescriptor = oDoc.createSearchDescriptor()
'
With oDescriptor
.SearchString = "t.s"
.SearchRegularExpression = true
.SearchCaseSensitive = False ' 大文字と小文字を区別するか?
End With
'
oFoundAll = oDoc.findAll(oDescriptor)
for i = o to oFoundAll.getCount()-1
oFound = oFoundAll.getByIndex(i)
oDisp = "検索された文字 => " & oFound.String
Print oDisp
next i
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
Rem 「t..s」ならば「t」と「s」の間に2文字ある文字を検索
Rem 「.」自体を検索する時は「\.」
WSR-)[Writer]正規表現( 直前の文字がないか、直前の文字が１個以上連続する文字 )
Sub oWriterSearchRepalce
Dim oDoc
Dim oWText
Dim oString
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
'
Dim oDescriptor
Dim oFound
Dim oFoundAll
oDescriptor = oDoc.createSearchDescriptor()
'
With oDescriptor
.SearchString = "to*"
.SearchRegularExpression = true
.SearchCaseSensitive = False ' 大文字と小文字を区別するか?
End With
'
oFoundAll = oDoc.findAll(oDescriptor)
for i = o to oFoundAll.getCount()-1
oFound = oFoundAll.getByIndex(i)
oDisp = "検索された文字 => " & oFound.String
Print oDisp
next i
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WSR-)[Writer]正規表現( 直前の文字が最低でも１個ある文字 )
Sub oWriterSearchRepalce
Dim oDoc
Dim oWText
Dim oString
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
'
Dim oDescriptor
Dim oFound
Dim oFoundAll
oDescriptor = oDoc.createSearchDescriptor()
'
With oDescriptor
.SearchString = "to+"
.SearchRegularExpression = true
.SearchCaseSensitive = False ' 大文字と小文字を区別するか?
End With
'
oFoundAll = oDoc.findAll(oDescriptor)
for i = o to oFoundAll.getCount()-1
oFound = oFoundAll.getByIndex(i)
oDisp = "検索された文字 => " & oFound.String
Print oDisp
next i
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WSR-)[Writer]正規表現( 直前の文字が全く無いか、１つだけある )
Sub oWriterSearchRepalce
Dim oDoc
Dim oWText
Dim oString
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
'
Dim oDescriptor
Dim oFound
Dim oFoundAll
oDescriptor = oDoc.createSearchDescriptor()
'
With oDescriptor
.SearchString = "to?"
.SearchRegularExpression = true
.SearchCaseSensitive = False ' 大文字と小文字を区別するか?
End With
'
oFoundAll = oDoc.findAll(oDescriptor)
for i = o to oFoundAll.getCount()-1
oFound = oFoundAll.getByIndex(i)
oDisp = "検索された文字 => " & oFound.String
Print oDisp
next i
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WSR-)[Writer]正規表現( 任意の長さの文字(無くてもOK)
Sub oWriterSearchRepalce
Dim oDoc
Dim oWText
Dim oString
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
'
Dim oDescriptor
Dim oFound
Dim oFoundAll
oDescriptor = oDoc.createSearchDescriptor()
'
With oDescriptor
.SearchString = "t.*"
.SearchRegularExpression = true
.SearchCaseSensitive = False ' 大文字と小文字を区別するか?
End With
'
oFoundAll = oDoc.findAll(oDescriptor)
for i = o to oFoundAll.getCount()-1
oFound = oFoundAll.getByIndex(i)
oDisp = "検索された文字 => " & oFound.String
Print oDisp
next i
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WSR-)[Writer]正規表現( 複数の検索候補の文字 )
Sub oWriterSearchRepalce
Dim oDoc
Dim oWText
Dim oString
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
'
Dim oDescriptor
Dim oFound
Dim oFoundAll
oDescriptor = oDoc.createSearchDescriptor()
'
With oDescriptor
.SearchString = "do.*nt|pa.*ph|fi.*st"
.SearchRegularExpression = true
.SearchCaseSensitive = False ' 大文字と小文字を区別するか?
End With
'
oFoundAll = oDoc.findAll(oDescriptor)
for i = o to oFoundAll.getCount()-1
oFound = oFoundAll.getByIndex(i)
oDisp = "検索された文字 => " & oFound.String
Print oDisp
next i
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WSR-)[Writer]正規表現( どれか１つに合致する文字検索 )
Sub oWriterSearchRepalce
Dim oDoc
Dim oWText
Dim oString
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
'
Dim oDescriptor
Dim oFound
Dim oFoundAll
oDescriptor = oDoc.createSearchDescriptor()
'
With oDescriptor
.SearchString = "[p-u]"
.SearchRegularExpression = true
.SearchCaseSensitive = False ' 大文字と小文字を区別するか?
End With
'
oFoundAll = oDoc.findAll(oDescriptor)
for i = o to oFoundAll.getCount()-1
oFound = oFoundAll.getByIndex(i)
oDisp = "検索された文字 => " & oFound.String
Print oDisp
next i
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
Rem A,B･･･Y,Zのいずれかの文字の場合は[A-Z]で検索できる。
WSR-)[Writer]正規表現( １文字ではなく、複数文字数の検索 )
Sub oWriterSearchRepalce
Dim oDoc
Dim oWText
Dim oString
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line." & Chr$(13) & _
"ththththird"
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
'
Dim oDescriptor
Dim oFound
Dim oFoundAll
oDescriptor = oDoc.createSearchDescriptor()
'
With oDescriptor
.SearchString = "(th)+..d"
.SearchRegularExpression = true
.SearchCaseSensitive = False ' 大文字と小文字を区別するか?
End With
'
oFoundAll = oDoc.findAll(oDescriptor)
for i = o to oFoundAll.getCount()-1
oFound = oFoundAll.getByIndex(i)
oDisp = "検索された文字 => " & oFound.String
Print oDisp
next i
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WSR-)[Writer]
Table[Writer]
WT-)[Writer]表作成(1)
Sub WriterTable()
Dim oDOc as Object, oTable as Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
End Sub
WT-)[Writer]表作成(2)
Sub WriterTable()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(3) 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 = "TableName"
oProp(0).Value = "MacroTable01"
oProp(1).Name = "Columns"
oProp(1).Value = 5
oProp(2).Name = "Rows"
oProp(2).Value = 3
oProp(3).Name = "Flags"
oProp(3).Value = 11
oDispatcher.executeDispatch( oFrame, ".uno:InsertTable", "", 0, oProp())
msgbox "Success" & Chr$(10) & "(DispatchHelper)",0,"Table"
End Sub
WT-)[Writer]表の挿入Dialog表示
Sub WriterTable()
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:InsertTable", "", 0, Array())
msgbox "Success" & Chr$(10) & "(DispatchHelper)",0,"Table"
End Sub
WT-)[Writer]表選択1
Sub oWriterTable
Dim oDoc
Dim oTable
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
' Table 選択
Dim oDispHelper 'Dispatch helper
Dim oVCursor 'The view cursor
oDoc.getCurrentController().select(oTable)
oVCursor = oDoc.getCurrentController().getViewCursor()
oVCursor.gotoEnd(True)
oVCursor.gotoEnd(True)
End Sub
WT-)[Writer]表選択2
Sub oWriterTable
Dim oDoc
Dim oTable
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
' Table 選択
Dim oDocTable as Object
Dim oSelTable as Object
Dim oTableName as String
oDocTable = oDoc.TextTables
oSelTable = oDocTable.getByIndex(0)
'
oTableName = oSelTable.Name
msgbox "Table Name => " & oTableName
End Sub
WT-)[Writer]表の左右にmargin設定
Sub oWriterTable
Dim oDoc
Dim oTable
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 表の左右にMarginを設定
oTable.HoriOrient = 0 'com.sun.star.text.HoriOrientation::NONE
oTable.LeftMargin = 2000
oTable.RightMargin = 1500
'
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
End Sub
WT-)[Writer]表中のCursor位置取得1
Sub oWriterTable
Dim oVCurs 'The view cursor
Dim oTable 'The text table that contains the text cursor.
Dim oCurCell 'The text table cell that contains the text cursor.
Dim oDoc
Dim Dummy()
oDoc=ThisComponent
' Cursor Position
oVCurs = oDoc.getCurrentController().getViewCursor()
If IsEmpty(oVCurs.TextTable) Then
Print "The cursor is NOT in a table"
Else
oTable = oVCurs.TextTable
oCurCell = oVCurs.Cell
oDisp = "The cursor is in cell " & oCurCell.CellName
Msgbox(oDisp, 0, "Curor Position in Table")
End If
End Sub
WT-)[Writer]表中のCursor位置取得2
Sub oWriterTable
Dim oDoc
Dim oTable
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
' Table 選択
Dim oVCurs 'The current view cursor.
oDoc.getCurrentController().select(oTable)
oVCurs = oDoc.getCurrentController().getViewCursor()
'
Dim oCell 'The cell that contains the cursor.
Dim oCol% 'The column that contains the cursor.
Dim oRow% 'The row that contains the cursor.
oCell = oVCurs.Cell
'Assume less than 26 columns
oCol = Asc(oCell.Cellname) - 65
oRow = CInt(Right(oCell.Cellname, Len(oCell.Cellname) - 1)) - 1
' Current Cell Name
oTableCurrentCellName = oCell.Cellname
oDisp = ODisp & "The cursor is in text table : " & oTable.getName() & CHR$(10) & _
"The current cell is " & oTableCurrentCellName
MsgBox(oDisp, 0, "選択されている表中のCursorの位置")
End Sub
WT-)[Writer]表中のCursor位置取得3
Sub oWriterTable
Dim oDoc
Dim oTable
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
' Table 選択
Dim oVCurs 'The current view cursor.
oDoc.getCurrentController().select(oTable)
oVCurs = oDoc.getCurrentController().getViewCursor()
'
Dim oCell 'The cell that contains the cursor.
Dim oCol% 'The column that contains the cursor.
Dim oRow% 'The row that contains the cursor.
oCell = oVCurs.Cell
'Assume less than 26 columns
oCol = Asc(oCell.Cellname) - 65
oRow = CInt(Right(oCell.Cellname, Len(oCell.Cellname) - 1)) - 1
' Current Cell Name
oDisp = ODisp & "The cursor is in text table : " & oTable.getName() & CHR$(10) & _
"The cell is at (" & oCol & ", " & oRow & ")"
MsgBox(oDisp, 0, "選択されている表中のCursorの位置")
End Sub
WT-)[Writer]表中のCursor位置移動
Sub oWriterTable
Dim oDoc
Dim oTable
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
' Table 選択
Dim oVCurs 'The current view cursor.
oDoc.getCurrentController().select(oTable)
oVCurs = oDoc.getCurrentController().getViewCursor()
'
' Cursor位置移動
Dim oCell 'The cell that contains the cursor.
oCell1 = oTable.getCellByPosition(1, 1)
oDoc.getCurrentController().select(oCell1)
End Sub
WT-)[Writer]表中の選択されているCell Range取得
Sub oWriterTable
Dim oSels 'All of the selections
Dim oSel 'A single selection
Dim i As Integer
Dim sTextTableCursor$
Dim oDoc
sTextTableCursor$ = "com.sun.star.text.TextTableCursor"
oDoc = ThisComponent
oSels = oDoc.getCurrentController().getSelection()
oDisp = "選択されている表の範囲は => " & oSels.getRangeName()
msgbox( oDisp, 0, "Selection Table Range")
End Sub
WT-)[Writer]表への値入力
Sub oWriterTable
Dim sName$
Dim oTable
Dim oAnchor
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
End Sub
WT-)[Writer]表の値取得1
Sub WriterTable()
Dim sName$
Dim oTable
Dim oAnchor
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
' 値取得
Dim oData()
oData() = oTable.getDataArray()
'
for i = 0 to 2
oDisp = oDisp & "[ " & i+1 & " 行目 ]" & Chr$(10)
oDisp = oDisp & Join(oData(i), CHR$(10))
oDisp = oDisp & Chr$(10)
next i
Msgbox ( oDisp, 0, "表中の値取得")
End Sub
WT-)[Writer]表の値取得2
Sub oWriterTable
Dim oDoc
Dim oVCTable
Dim oVC
Dim oCell
Dim oCol As Long
Dim oRow As Long
oDoc = ThisComponent
oVC = oDoc.getCurrentController().getViewCursor()
If IsEmpty(oVC.TextTable) Then
Print "The view cursor is not in a text table"
Exit Sub
End If
'oSelected = oDoc.getCurrentController().getSelection()
oVCTable = oVC.TextTable
oTableRow = oVCTable.getRows().getCount()
oTableColumn = oVCTable.getColumns().getCount()
'
For oRow = 0 To oTableRow - 1
For oCol = 0 To oTableColumn - 1
oCell = oVCTable.getCellByPosition(oCol, oRow)
oDisp = oDisp & oCell.CellName & ":" & oCell.getString() & CHR$(10)
Next
Next
Msgbox(oDisp, 0, "Tabelの値取得")
End Sub
WT-)[Writer]表の値Clear
Sub oWriterTable
Dim sName$
Dim oTable
Dim oAnchor
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
' 値Clear
Dim oRange
Dim oData()
Dim oRaw()
oRange = oTable.getCellRangeByName("B2:C3")
oData() = oRange.getDataArray()
For i = LBound(oData()) To UBound(oData())
oRow() = oData(i)
For j = LBound(oRow()) To UBound(oRow())
oRow(j) = ""
Next j
Next i
oRange.setDataArray(oData())
End Sub
WT-)[Writer]表の名前取得
Sub oWriterTable
Dim oTable
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
' Get Table Name
oTableName = oTable.getName()
' Display
oDisp = "Table Name : " & oTableName
msgbox(oDisp, 0, "WriterTable")
End Sub
WT-)[Writer]表の名前取得2
Sub WriterTable()
Dim oTable
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
'
Dim oDocTables
Dim oTableNum
Dim oTableName
oDocTables = oDoc.getTextTables()
oTableNum = oDocTables.getCount()
'
If NOT oDocTables.hasElements() Then Exit Sub
For i = 0 To oDocTables.getCount() - 1
oTable = oDocTables.getByIndex(i)
oTableName = oTable.getName()
oDisp = oDisp & "Table Name => " & oTableName & CHR$(10)
Next i
MsgBox(oDisp, 0, "Table Name")
End Sub
WT-)[Writer]表の名前取得3
Sub oWriterTable
Dim oTable
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
'
Dim oDocTables
Dim oTableNum
oDocTables = oDoc.getTextTables()
oTableNum = oDocTables.getCount()
'
If NOT oDocTables.hasElements() Then Exit Sub
oDisp = Join(oDocTables.getElementNames(), CHR$(10))
MsgBox(oDisp, 0, "Table Name")
End Sub
WT-)[Writer]表の行列数取得1
Sub oWriterTable
Dim oDoc
Dim oVCTable
Dim oVC
Dim oCell
Dim oCol As Long
Dim oRow As Long
oDoc = ThisComponent
oVC = oDoc.getCurrentController().getViewCursor()
If IsEmpty(oVC.TextTable) Then
Print "The view cursor is not in a text table"
Exit Sub
End If
'oSelected = oDoc.getCurrentController().getSelection()
oVCTable = oVC.TextTable
oTableRow = oVCTable.getRows().getCount()
oTableColumn = oVCTable.getColumns().getCount()
oDisp = "Rows = " & oTableRow & Chr$(10) & _
"Column = " & oTableColumn
'
Msgbox(oDisp, 0, "行列数取得 in Writer Table")
End Sub
WT-)[Writer]表の行列数取得2
Sub oWriterTable
Dim oDoc
Dim oTable
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
' Table 選択
Dim oVCurs 'The current view cursor.
oDoc.getCurrentController().select(oTable)
oVCurs = oDoc.getCurrentController().getViewCursor()
'
Dim oCell 'The cell that contains the cursor.
Dim oCol% 'The column that contains the cursor.
Dim oRow% 'The row that contains the cursor.
oCell = oVCurs.Cell
'Assume less than 26 columns
oCol = Asc(oCell.Cellname) - 65
oRow = CInt(Right(oCell.Cellname, Len(oCell.Cellname) - 1)) - 1
'
oDisp = ODisp & "The cursor is in text table : " & oTable.getName() & CHR$(10) & _
CHR$(10) & "The table has " & oTable.getColumns().getCount() & _
" columns and " & oTable.getRows().getCount() & " Rows" & CHR$(10)
MsgBox(oDisp, 0, "表の行列数取得")
End Sub
WT-)[Writer]表の削除1
Sub oWriterTable
Dim oTable
Dim oTableName
Dim oWriterTable
Dim oAnchor
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
' Get Table Name
oTableName = oTable.getName()
' TableのAnchor取得
oWTable = oDoc.getTextTables().getByName(oTableName)
oAnchor = oWTable.getAnchor()
' Documentの最初にCursorを移動
oCurs = oDoc.getCurrentController().getViewCursor()
oCurs.gotoStart(False)
' I would Love to be able to move the cursor to the anchor, but I can not create a crusor based on the anchor, move to
' the anchor, etc. So, I use a trick and let the controller move the view cursor to the table.
' Unfortunately, you can not move the cursor to the anchor...
' Tableの選択
oDoc.getCurrentController().select(oTable)
' Table 削除
oTable.dispose()
End Sub
WT-)[Writer]表の削除2
Sub oWriterTable
Dim oText as Object
Dim oTable as Object
Dim oTableName as String
Dim oWriterTable as Object
Dim oAnchor as Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oText.insertTextContent(oDoc.Text.getEnd(), oTable, false)
' Get Table Name
oTableName = oTable.getName()
' TableのAnchor取得
oWTable = oDoc.getTextTables().getByName(oTableName)
' Table 削除
oText.removeTextContent(oWTable)
'
msgbox "Success"
End Sub
WT-)[Writer]表中の2列目にCuror移動
Sub oWriterTable
Dim oDoc
Dim oTable
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
' Table 選択
Dim oVCurs 'The current view cursor.
oDoc.getCurrentController().select(oTable)
oVCurs = oDoc.getCurrentController().getViewCursor()
'
' 2列目にCursor移動
oVCurs.goDown(1,False)
End Sub
WT-)[Writer]表の前にCuror移動
Sub oWriterTable
Dim oText as Object
Dim oTable
Dim oWTable
Dim oCurs
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oSText = "[ Writer Table ] " & Chr$(13)
oText.insertString(oText.getStart(), oSText , false) '文頭
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
oTableName = oTable.getName()
'
oWTable = oDoc.getTextTables().getByName(oTableName)
'Move the cursor to the first row and column
oDoc.getCurrentController().select(oWTable)
oCurs = oDoc.getCurrentController().getViewCursor()
oCurs.goLeft(1, False)
End Sub
WT-)[Writer]表の前にParagraph挿入
Sub WriterTable()
Dim oText as Object
Dim oTable
Dim oWTable
Dim oCurs
Dim oDoc
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oSText = "[ Writer Table ] " & Chr$(13)
oText.insertString(oText.getStart(), oSText , false) '文頭
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
' oTableName = oTable.getName()
'
oWTable = oDoc.getTextTables().getByIndex(0)
' Insert Paragraph
oCurs = oText.createTextCursor()
oPar = oDoc.createInstance("com.sun.star.text.Paragraph")
oText.insertTextContentBefore ( oPar, oWTable )
End Sub
WT-)[Writer]Document中の表数取得
Sub WriterTable()
Dim oTable
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
'
Dim oDocTables
Dim oTableNum
oDocTables = oDoc.getTextTables()
oTableNum = oDocTables.getCount()
oDisp = "This document contains " & oTableNum & " tables"
'
msgbox(oDisp, 0, "Table数取得")
End Sub
WT-)[Writer]外枠線を消す
Sub WriterTable()
Dim oDoc
Dim oText
Dim oTable
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'
oText = oDoc.getText()
oDisp = "FirstLine" & Chr$(10)
oText.insertString(oText.getEnd(), oDisp, false)
'
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oText.insertTextContent(oText.getEnd(), oTable, false)
'
Dim v
Dim x
v = oTable.TableBorder
x = v.TopLine : x.OuterLineWidth = 0 : v.TopLine = x
x = v.LeftLine : x.OuterLineWidth = 0 : v.LeftLine = x
x = v.RightLine : x.OuterLineWidth = 0 : v.RightLine = x
x = v.BottomLine : x.OuterLineWidth = 0 : v.BottomLine = x
oTable.TableBorder = v
End Sub
WT-)[Writer]外枠線を極太線にする
Sub WriterTable()
Dim oDoc
Dim oText
Dim oTable
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'
oText = oDoc.getText()
oDisp = "FirstLine" & Chr$(10)
oText.insertString(oText.getEnd(), oDisp, false)
'
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oText.insertTextContent(oText.getEnd(), oTable, false)
'
Dim v
Dim x
v = oTable.TableBorder
x = v.TopLine : x.OuterLineWidth = 200 : v.TopLine = x ' 200 => 5pt
x = v.LeftLine : x.OuterLineWidth = 200 : v.LeftLine = x
x = v.RightLine : x.OuterLineWidth = 200 : v.RightLine = x
x = v.BottomLine : x.OuterLineWidth = 200 : v.BottomLine = x
oTable.TableBorder = v
End Sub
WT-)[Writer]内枠線を消す
Sub WriterTable()
Dim oDoc
Dim oText
Dim oTable
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'
oText = oDoc.getText()
oDisp = "FirstLine" & Chr$(10)
oText.insertString(oText.getEnd(), oDisp, false)
'
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oText.insertTextContent(oText.getEnd(), oTable, false)
'
Dim v
Dim x
v = oTable.TableBorder
x = v.VerticalLine : x.OuterLineWidth = 0 : v.VerticalLine = x
x = v.HorizontalLine : x.OuterLineWidth = 0 : v.HorizontalLine = x
oTable.TableBorder = v
End Sub
WT-)[Writer]内枠線を極太線にする
Sub WriterTable()
Dim oDoc
Dim oText
Dim oTable
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'
oText = oDoc.getText()
oDisp = "FirstLine" & Chr$(10)
oText.insertString(oText.getEnd(), oDisp, false)
'
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oText.insertTextContent(oText.getEnd(), oTable, false)
'
Dim v
Dim x
v = oTable.TableBorder
x = v.VerticalLine : x.OuterLineWidth = 200 : v.VerticalLine = x ' 200 => 5pt
x = v.HorizontalLine : x.OuterLineWidth = 200 : v.HorizontalLine = x
oTable.TableBorder = v
End Sub
WT-)[Writer]線の色設定
Sub WriterTable()
Dim oDoc
Dim oText
Dim oTable
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'
oText = oDoc.getText()
oDisp = "FirstLine" & Chr$(10)
oText.insertString(oText.getEnd(), oDisp, false)
'
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oText.insertTextContent(oText.getEnd(), oTable, false)
'
Dim v
Dim x
v = oTable.TableBorder
x = v.TopLine : x.OuterLineWidth = 2 : x.Color = RGB(255, 0, 0) : v.TopLine = x ' 2 => 0.05pt
x = v.LeftLine : x.OuterLineWidth = 2 : x.Color = RGB(255, 0, 0) : v.LeftLine = x
x = v.RightLine : x.OuterLineWidth = 2 : x.Color = RGB(255, 0, 0) : v.RightLine = x
x = v.VerticalLine : x.OuterLineWidth = 2 : v.VerticalLine = x ' 2 => 0.05pt
x = v.HorizontalLine : x.OuterLineWidth = 2 : v.HorizontalLine = x
x = v.BottomLine : x.OuterLineWidth = 2 : x.Color = RGB(255, 0, 0) : v.BottomLine = x
oTable.TableBorder = v
End Sub
WT-)[Writer]Cellの背景設定
Sub WriterTable()
Dim oDoc
Dim oText
Dim oTable
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'
oText = oDoc.getText()
oDisp = "FirstLine" & Chr$(10)
oText.insertString(oText.getEnd(), oDisp, false)
'
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 5) ' 3 rows, 5 columns
oText.insertTextContent(oText.getEnd(), oTable, false)
'
Dim v
Dim x
v = oTable.TableBorder
x = v.TopLine : x.OuterLineWidth = 2 : v.TopLine = x ' 2 => 0.05pt
x = v.LeftLine : x.OuterLineWidth = 2 : v.LeftLine = x
x = v.RightLine : x.OuterLineWidth = 2 : v.RightLine = x
x = v.VerticalLine : x.OuterLineWidth = 2 : v.VerticalLine = x ' 2 => 0.05pt
x = v.HorizontalLine : x.OuterLineWidth = 2 : v.HorizontalLine = x
x = v.BottomLine : x.OuterLineWidth = 2 : v.BottomLine = x
oTable.TableBorder = v
'
Dim oCell
Dim oRow As Long
Dim oCol As Long
For oRow = 0 To oTable.getRows().getCount() - 1
For oCol = 0 To oTable.getColumns().getCount() - 1
oCell = oTable.getCellByPosition(oCol, oRow)
If oRow = 0 Then
oCell.BackColor = 128
Else
If oRow MOD 2 = 1 Then
oCell.BackColor = -1
Else
' color is (230, 230, 230)
oCell.BackColor = 15132390
End If
End If
Next
Next
End Sub
WT-)[Writer]Cell幅変更
Sub WriterTable()
Dim sName$
Dim oTable
Dim oAnchor
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
'
Dim oTblColSeps 'The array of table column separators.
oTblColSeps = oTable.TableColumnSeparators
'Change the positions
oTblColSeps(0).Position = 500 ' 0 => 左側から1番目の内枠縦線
oTblColSeps(1).Position = 1500 ' 1 => 左側から2番目の内枠縦線
'To be assigned the array back
oTable.TableColumnSeparators = oTblColSeps
End Sub
WT-)[Writer]Cell幅変更2
Sub WriterTable()
Dim sName$
Dim oTable
Dim oAnchor
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
' Table Width 変更
Dim oDispHelper 'Dispatch helper
Dim oFrame 'Current window frame.
Dim oVCursor 'The view cursor
oDoc.getCurrentController().select(oTable)
oVCursor = oDoc.getCurrentController().getViewCursor()
oVCursor.gotoEnd(True)
oVCursor.gotoEnd(True)
'
oFrame = oDoc.CurrentController.Frame
oDispHelper = createUnoService("com.sun.star.frame.DispatchHelper")
oDispHelper.executeDispatch(oFrame, ".uno:SetOptimalColumnWidth", "", 0, Array())
End Sub
WT-)[Writer]autoFormat1
Sub WriterTable()
Dim oDoc
Dim oTable
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
' autoFormat
oTable.autoFormat("3D")
' Display
msgbox "Success"
End Sub
'
' [ Format Name ]
' FormatNameは以下の様な値があるが、3D以外は設定されない。
' 3D
' Black 1
' Black 2
' Blue
' Brown
' Currency
' Currency 3D
' Currency Lavender
' Currency Turquoise
' Gray
' Green
' 参考uRL : http://wiki.services.openoffice.org/wiki/Documentation/OOo3_User_Guides/Calc_Guide/Autoformat_and_themes
WT-)[Writer]各Cellの値を残してCell結合
Sub WriterTable()
Dim oDoc
Dim oTable
Dim oCurs
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
' Create Table
oTable = oDoc.createInstance("com.sun.star.text.TextTable")
oTable.initialize(3, 3)
' 入力範囲設定
oCurs = oDoc.getCurrentController().getViewCursor()
oText.insertTextContent(oCurs, oTable, False)
' 入力
oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
'
' Cursor位置移動
Dim oTableCur as Object
' Cursor位置をB2へ
oTableCur =oTable.createCursorByCellName("B2")
' 範囲指定（右に1セル、下に1セル)
oTableCur.goRight(1,True)
oTableCur.goDown(1,True)
' Merge
oTableCur.mergeRange()
'
msgbox "Success"
End Sub
WT-)[Writer]
Style
WSt-)[Writer]Capter Style取得
Sub oCNumberRule
Dim i%
Dim oRules
Dim oRule()
Dim oProp
On Error Resume Next
oDoc = ThisComponent
'
oRules = oDoc.getChapterNumberingRules()
oRuleCount = oRules.getCount()
'
For i = 0 To oRuleCount - 1
oRule() = oRules.getByIndex(i)
oProp = oRule(i)
oPName = oProp.Name
oDisp = oDisp & i & ")" & oPName
oDisp = oDisp & " => " & oProp.Value
oDisp = oDisp & Chr$(10)
Next i
msgbox( oDisp, 0, "ChapterNumberingRules")
End Sub
WSt-)[Writer]2列書き
Sub oAddTextSection
Dim oDoc
Dim Dummy()
Dim oSect
Dim oName$
Dim oVC
Dim oText
Dim oCols
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'
oVC = oDoc.getCurrentController().getViewCursor()
oText = oVC.getText()
oDisp = "This is One Column."
oText.insertString(oText.getEnd(), oDisp, false)
'
oText.insertControlCharacter(oVC, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
oText.insertControlCharacter(oVC, com.sun.star.text.ControlCharacter.LINE_BREAK, True)
'
oSect = oDoc.createInstance("com.sun.star.text.TextSection")
oName = "CreateSectionInWriter"
oSect.setName(oName)
'.
oCols = oDoc.createInstance("com.sun.star.text.TextColumns")
oCols.setColumnCount(2)
oSect.TextColumns = oCols
oText.insertTextContent(oVC, oSect, True)
'
oDisp = "This is new text. " & _
"I suppose that I could count and repeat myself as " & _
"an example of how text can go on and on and on. " & _
"I suppose that I could count and repeat myself as " & _
"an example of how text can go on and on and on. " & _
"I suppose that I could count and repeat myself as " & _
"an example of how text can go on and on and on. " & _
"I suppose that I could count and repeat myself as " & _
"an example of how text can go on and on and on. " & _
"I suppose that I could count and repeat myself as " & _
"an example of how text can go on and on and on. " & _
"I suppose that I could count and repeat myself as " & _
"an example of how text can go on and on and on. " & _
"And finally I will stop."
oText.insertString(oVC, oDisp, True)
'
oCols = oSect.TextColumns
Dim oOC()
oOC() = oCols.getColumns()
'
oOC(0).RightMargin = 500 ' Unit : 1/100mm
oOC(1).LeftMargin = 500 ' Unit : 1/100mm
'
oCols.setColumns(oOC())
oSect.TextColumns = oCols
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WSt-)[Writer]Section数取得
Sub oAddTextSection
Dim oDoc
Dim Dummy()
Dim oSect
Dim oName$
Dim oVC
Dim oText
Dim oCols
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'
oVC = oDoc.getCurrentController().getViewCursor()
oText = oVC.getText()
oDisp = "This is One Column."
oText.insertString(oText.getEnd(), oDisp, false)
'
oText.insertControlCharacter(oVC, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
oText.insertControlCharacter(oVC, com.sun.star.text.ControlCharacter.LINE_BREAK, True)
'
oSect = oDoc.createInstance("com.sun.star.text.TextSection")
oName = "CreateSectionInWriter"
oSect.setName(oName)
'.
oCols = oDoc.createInstance("com.sun.star.text.TextColumns")
oCols.setColumnCount(2)
oSect.TextColumns = oCols
oText.insertTextContent(oVC, oSect, True)
'
oDisp = "This is new text. " & _
"I suppose that I could count and repeat myself as " & _
"an example of how text can go on and on and on. " & _
"I suppose that I could count and repeat myself as " & _
"an example of how text can go on and on and on. " & _
"I suppose that I could count and repeat myself as " & _
"an example of how text can go on and on and on. " & _
"I suppose that I could count and repeat myself as " & _
"an example of how text can go on and on and on. " & _
"I suppose that I could count and repeat myself as " & _
"an example of how text can go on and on and on. " & _
"I suppose that I could count and repeat myself as " & _
"an example of how text can go on and on and on. " & _
"And finally I will stop."
oText.insertString(oVC, oDisp, True)
'
oCols = oSect.TextColumns
Dim oOC()
oOC() = oCols.getColumns()
'
oOC(0).RightMargin = 500 ' Unit : 1/100mm
oOC(1).LeftMargin = 500 ' Unit : 1/100mm
'
oCols.setColumns(oOC())
oSect.TextColumns = oCols
'
oSectionNum = oDoc.getTextSections().getCount() + 1
oDisp = "Section数は" & Chr$(10) & " " & oSectionNum
msgbox(oDisp, 0, "Section数")
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
[ CharacterStyles ]
WStS-)[Writer]Style Name取得
Sub oWriterStyle
Dim oDoc
Dim oText
Dim oCur
Dim oObj
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'Get the StyleFamilies
Dim oFamilies
Dim oFamilyNames
Dim oStyleName
oFamilies = oDoc.StyleFamilies
oFamilyNames = oFamilies.getElementNames()
oStyleName = oFamilies.getByName("CharacterStyles")
oSElementName = oStyleName.ElementNames
oDisp = ""
'Get the Style Name
for i = LBound(oSElementName) to UBound(oSElementName)
oDisp = oDisp & i & ")" & oSElementName(i)
oDisp = oDisp & Chr$(10)
next i
msgbox(oDisp, 0, "Style Name")
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WStS-)[Writer]CharacterStyle変更
Sub oWriterStyle
Dim oDoc
Dim oSelections
Dim oSel
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oSelections = oDoc.getCurrentSelection()
oSel = oSelections.getByIndex(0)
' 変更前のStyle Name取得
oStyleName1 = oSel.CharStyleName
oDisp = "変更前のStyle Name :" & oStyleName1
oDisp = oDisp & Chr$(10) & Chr$(10)
' Style Nameの変更
oSel.CharStyleName = "Numbering Symbols"
'
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
' Confirm
oStyleName2 = oSel.CharStyleName
oDisp = oDisp & "変更後のStyle Name :" & oStyleName2
msgbox(oDisp, 0, "Style変更")
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
[ ParagraphStyles ]
WStP-)[Writer]Style Name取得
Sub oWriterStyle
Dim oDoc
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'Get the StyleFamilies
Dim oFamilies
Dim oFamilyNames
Dim oStyleName
oFamilies = oDoc.StyleFamilies
oFamilyNames = oFamilies.getElementNames()
oStyleName = oFamilies.getByName("ParagraphStyles")
oSElementName = oStyleName.ElementNames
oDisp = ""
'Get the Style Name
for i = LBound(oSElementName) to UBound(oSElementName)
oDisp = oDisp & i & ")" & oSElementName(i)
oDisp = oDisp & Chr$(10)
next i
msgbox(oDisp, 0, "Style Name")
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WStP-)[Writer]ParagraphStyle変更
Sub oWriterStyle
Dim oDoc
Dim oSelections
Dim oSel
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oSelections = oDoc.getCurrentSelection()
oSel = oSelections.getByIndex(0)
' 変更前のStyle Name取得
oStyleName1 = oSel.ParaStyleName
oDisp = "変更前のStyle Name :" & oStyleName1
oDisp = oDisp & Chr$(10) & Chr$(10)
' Style Nameの変更
oSel.ParaStyleName = "Heading 2"
' Confirm
oStyleName2 = oSel.ParaStyleName
oDisp = oDisp & "変更後のStyle Name :" & oStyleName2
msgbox(oDisp, 0, "Style変更")
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
[ Tab Stop ]
WStTb-)[Writer]Tab Stop1
Sub oTabStop
Dim oDoc as Object
Dim oText as Object
Dim oDisp as String
Dim oStyleFamily as Object
Dim oParentStyleName as String
Dim oStyleName as String
oDoc = ThisComponent
'
oStyle = oDoc.createInstance( "com.sun.star.style.ParagraphStyle" )
'
oStyleName = "oTabStopStyle"
oParentStyleName = "oHeading"
If IsMissing( oParentStyleName ) Then
oParentStyleName = ""
End If
'
oStyleFamily = oDoc.getStyleFamilies().getByName( "ParagraphStyles" )
'
' Does the style already exist?
If oStyleFamily.hasByName( oStyleName ) Then
' Then get it so we can return it.
oStyle = oStyleFamily.getByName( oStyleName )
Else
' Create new style object.
oStyle = oDoc.createInstance( "com.sun.star.style.ParagraphStyle" )
'
' Set its parent style, if one is specified.
If Not IsMissing( oParentStyleName ) And Len( oParentStyleName ) > 0 Then
oStyle.setParentStyle( oParentStyleName )
End If
'
' Add the new style to the style family.
oStyleFamily.insertByName( oStyleName, oStyle )
End If
'
oStyle.ParaTabStops =Array(MakeTabStop(80000),MakeTabStop(40000))
'
oText = oDoc.getText()
oDisp = Chr$(9) & "Tab11" & Chr$(9) & "Tab12" & Chr$(9) & "Tab13" & Chr$(10) & _
Chr$(9) & "Tab21" & Chr$(9) & "Tab22" & Chr$(9) & "Tab23" & Chr$(13) & _
Chr$(9) & "Tab31" & Chr$(9) & "Tab32" & Chr$(9) & "Tab33"
oText.insertString(oText.getEnd(), oDisp, false)
End Sub
'
Function MakeTabStop( ByVal nPosition As Long) As com.sun.star.style.TabStop
Dim oTabStop as Object
oTabStop = createUnoStruct( "com.sun.star.style.TabStop" )
'
' Tab Stop位置
oTabStop.Position = nPosition ' 1/1000cm
'
' Tab Stopに対する文の位置
oTabStop.Alignment = com.sun.star.style.TabAlign.LEFT
'
'Tabを表示する文字
oTabStop.FillChar = ASC("･")
'
MakeTabStop() = oTabStop
End Function
'
' [ Alignment ]
' com.sun.star.style.TabAlign.LEFT = 0
' com.sun.star.style.TabAlign.CENTER = 1
' om.sun.star.style.TabAlign.RIGHT = 2
' com.sun.star.style.TabAlign.DECIMAL = 3
' com.sun.star.style.TabAlign.DEFAULT = 4
WStTb-)[Writer]Tab Stop2
Sub oTabStop
Dim oDoc as Object
Dim oText as Object
Dim oDisp as String
Dim viewCursor as Object
Dim oCursor as Object
oDoc = ThisComponent
'
viewCursor = oDoc.currentController.getViewCursor()
oCursor = oDoc.Text.createTextCursorByRange(viewCursor.getStart())
'
oCursor.ParaTabStops = Array(MakeTabStop(5000))
'
oText = oDoc.getText()
oDisp = Chr$(9) & "Tab11" & Chr$(9) & "Tab12" & Chr$(9) & "Tab13" & Chr$(10) & _
Chr$(9) & "Tab21" & Chr$(9) & "Tab22" & Chr$(9) & "Tab23" & Chr$(13) & _
Chr$(9) & "Tab31" & Chr$(9) & "Tab32" & Chr$(9) & "Tab33"
oText.insertString(oText.getEnd(), oDisp, false)
End Sub
'
Function MakeTabStop( ByVal nPosition As Long) As com.sun.star.style.TabStop
Dim oTabStop as Object
oTabStop = createUnoStruct( "com.sun.star.style.TabStop" )
'
' Tab Stop位置
oTabStop.Position = nPosition ' 1/1000cm
'
' Tab Stopに対する文の位置
oTabStop.Alignment = com.sun.star.style.TabAlign.LEFT
'
' Tabの代わりに表示する文字
oTabStop.FillChar = Asc("･")
'
MakeTabStop() = oTabStop
End Function
'
' [ Alignment ]
' com.sun.star.style.TabAlign.LEFT = 0
' com.sun.star.style.TabAlign.CENTER = 1
' om.sun.star.style.TabAlign.RIGHT = 2
' com.sun.star.style.TabAlign.DECIMAL = 3
' com.sun.star.style.TabAlign.DEFAULT = 4
[ PageStyles ]
WStPg-)[Writer]Style Name取得
Sub oWriterStyle
Dim oDoc
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'Get the StyleFamilies
Dim oFamilies
Dim oFamilyNames
Dim oStyleName
oFamilies = oDoc.StyleFamilies
oFamilyNames = oFamilies.getElementNames()
oStyleName = oFamilies.getByName("PageStyles")
oSElementName = oStyleName.ElementNames
oDisp = ""
'Get the Style Name
for i = LBound(oSElementName) to UBound(oSElementName)
oDisp = oDisp & i & ")" & oSElementName(i)
oDisp = oDisp & Chr$(10)
next i
msgbox(oDisp, 0, "Style Name")
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WStPg-)[Writer](未完成)PageStylesStyle変更
Sub oWriterStyle
Dim oDoc
Dim oSelections
Dim oSel
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oSelections = oDoc.getCurrentSelection()
oSel = oSelections.getByIndex(0)
' 変更前のStyle Name取得
oStyleName1 = oSel.PageStyleName
oDisp = "変更前のStyle Name :" & oStyleName1
oDisp = oDisp & Chr$(10) & Chr$(10)
' Style Nameの変更
oSel.PageStyleName = "Footnote"
'
oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oString, false)
' Confirm
oStyleName2 = oSel.PageStyleName
oDisp = oDisp & "変更後のStyle Name :" & oStyleName2
msgbox(oDisp, 0, "Style変更")
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
[ NumberingStyles ]
WStNum-)[Writer]Style Name取得
Sub oWriterStyle
Dim oDoc
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'Get the StyleFamilies
Dim oFamilies
Dim oFamilyNames
Dim oStyleName
oFamilies = oDoc.StyleFamilies
oFamilyNames = oFamilies.getElementNames()
oStyleName = oFamilies.getByName("NumberingStyles")
oSElementName = oStyleName.ElementNames
oDisp = ""
'Get the Style Name
for i = LBound(oSElementName) to UBound(oSElementName)
oDisp = oDisp & i & ")" & oSElementName(i)
oDisp = oDisp & Chr$(10)
next i
msgbox(oDisp, 0, "Style Name")
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
WStNum-)[Writer](未完成)NumberingStylesStyle変更
HyperLink[Writer]
[ BookMark ]
WHB-)[Writer]Bookmark設定
Sub oWriterBkMk
Dim oDoc
Dim oBookMark
Dim oCurs
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
' Insert Text
oText = oDoc.getText()
oString = "Openoffice.org Basic Macro for BookMark" & Chr$(13) & "Here"
oText.insertString(oText.getEnd(), oString, false) '文末
'
oCurs = oDoc.Text.createTextCursor()
oCurs.gotoEnd(False)
oCurs.goLeft(4,True)
'
oBookMark = oDoc.createInstance("com.sun.star.text.Bookmark")
oBookMark.setName("macro")
oText.insertTextContent(oCurs, oBookMark, False)
End Sub
WHB-)[Writer]bookmark anchorのSelect
Sub oWriterBkMk
Dim oAnchor 'Bookmark anchor
Dim oCursor 'Cursor at the left most range.
Dim oMarks
Dim oCurs
Dim oDoc
Dim oBookMark
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
' Insert Text
oText = oDoc.getText()
oString = "Openoffice.org Basic Macro for BookMark" & Chr$(13) & "Here"
oText.insertString(oText.getEnd(), oString, false) '文末
'
oCurs = oDoc.Text.createTextCursor()
oCurs.gotoEnd(False)
oCurs.goLeft(4,True)
'
oBookMark = oDoc.createInstance("com.sun.star.text.Bookmark")
oBookMark.setName("macro")
oText.insertTextContent(oCurs, oBookMark, False)
'
oMarks = oDoc.getBookmarks()
oAnchor = oMarks.getByName("macro").getAnchor()
oCursor = oDoc.getCurrentController().getViewCursor()
oCursor.gotoRange(oAnchor, False)
End Sub
WHB-)[Writer]Bookmark AnchorとCurosrの位置関係取得
Sub oWriterBkMk
Dim oAnchor 'Bookmark anchor
Dim oCursor 'Cursor at the left most range.
Dim oMarks
Dim oCurs
Dim oDoc
Dim oBookMark
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
' Insert Text
oText = oDoc.getText()
oString = "Openoffice.org Basic Macro for BookMark" & Chr$(13) & "Here"
oText.insertString(oText.getEnd(), oString, false) '文末
'
oCurs = oDoc.Text.createTextCursor()
oCurs.gotoEnd(False)
oCurs.goLeft(4,True)
'
oBookMark = oDoc.createInstance("com.sun.star.text.Bookmark")
oBookMark.setName("macro")
oText.insertTextContent(oCurs, oBookMark, False)
'
oMarks = oDoc.getBookmarks()
oAnchor = oMarks.getByName("macro").getAnchor()
oCursor = oDoc.getCurrentController().getViewCursor()
oCursor.gotoRange(oAnchor, False)
'
If NOT EqualUNOObjects(oCursor.getText(), oAnchor.getText()) Then
Print "The view cursor and the anchor use a different text object"
Exit Sub
End If
'
Dim oCursText, oEnd1, oEnd2
oDisp = "[ Bookmark AnchorとCurosrの関係 ]" & Chr$(10)
oCursText = oCursor.getText()
oEnd1 = oCursor.getEnd()
oEnd2 = oAnchor.getEnd()
If oCursText.compareRegionStarts(oEnd1, oEnd2) >= 0 Then
oDisp = oDisp & "Cursor END is Left of the anchor end"
Else
oDisp = oDisp & "Cursor END is Right of the anchor end"
End If
' Display
msgbox(oDisp , 0 , "Writer Bookmark")
End Sub
WHB-)[Writer]Insert text at a bookmark
Sub oWriterBkMk
Dim oAnchor 'Bookmark anchor
Dim oCursor 'Cursor at the left most range.
Dim oMarks
Dim oCurs
Dim oDoc
Dim oBookMark
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
' Insert Text
oText = oDoc.getText()
oString = "Openoffice.org Basic Macro for BookMark" & Chr$(13) & "Here"
oText.insertString(oText.getEnd(), oString, false) '文末
'
oCurs = oDoc.Text.createTextCursor()
oCurs.gotoEnd(False)
oCurs.goLeft(4,True)
'
oBookMark = oDoc.createInstance("com.sun.star.text.Bookmark")
oBookMark.setName("macro")
oText.insertTextContent(oCurs, oBookMark, False)
'
oMarks = oDoc.getBookmarks()
oAnchor = oMarks.getByName("macro").getAnchor()
oCursor = oDoc.getCurrentController().getViewCursor()
oCursor.gotoRange(oAnchor, False)
'
oBookMark1 = oDoc.getBookmarks().getByName("macro")
oString1 = " Insert Text At Bookmark"
oBookMark1.getAnchor.setString(oString1)
End Sub
[ Index ]
WHI-)[Writer]Index作成
Sub oDocument
Dim oDoc
Dim oText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
'
Dim oIndex
Dim oCurs
oIndex = oDoc.createInstance("com.sun.star.text.ContentIndex")
'
oIndex.CreateFromOutline = True
'
oCurs = oText.createTextCursor()
oCurs.gotoStart(False)
oText.insertTextContent(oCurs, oIndex, False)
'
oIndex.update()
End Sub
WHI-)[Writer]O
[ HyperLink ]
WHH-)[Writer]HyperLink設定
Sub WriterHyperLink()
Dim oDoc
Dim oText 'Text object for the current object
Dim oVCursor 'Current view cursor
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'
oVCursor = oDoc.getCurrentController().getViewCursor()
oText = oVCursor.getText()
oText.insertString(oVCursor, "OpenOffice.org Community", True)
'
oVCursor.HyperLinkURL = "http://www.openoffice.org/"
End Sub
WHH-)[Writer]
Outline
WOt-)[Writer]Outline設定1
Sub WriterOutline()
Dim oDoc as Object
Dim Dummy()
Dim document as Object
Dim dispatcher as Object
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
' Dispatcher
document = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
Dim oArgs1(0) as new com.sun.star.beans.PropertyValue
for i = 1 to 9
oArgs1(0).Name = "NumRule"
oArgs1(0).Value = "List " & i
dispatcher.executeDispatch(document, ".uno:NumRule", "", 0, args1())
'
oOutlineText = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
"This line is first paragraph too. But it is second line." & Chr$(13) & _
"This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line."
oWText = oDoc.getText()
oWText.insertString(oWText.getEnd(), oOutlineText, false)
next i
End Sub
WOt-)[Writer]Outline設定2a
Sub WriterOutline()
Dim oDoc as Object
Dim Dummy()
Dim document as Object
Dim dispatcher as Object
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
' Dispatcher
document = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
Dim oArgs1(0) as new com.sun.star.beans.PropertyValue
Dim oArgs2(1) as new com.sun.star.beans.PropertyValue
Dim oArgs3(0) as new com.sun.star.beans.PropertyValue
for i = 1 to 3
oWText = oDoc.getText()
If i = 1 then
oSubjOutline = "[ OutLine " & i & " ]"
oWText.insertString(oWText.getEnd(), oSubjOutline, false)
oWText.insertControlCharacter(oWText.getEnd(), com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
else
oSubjOutline = Chr$(10) & "[ OutLine " & i & " ]"
oWText.insertString(oWText.getEnd(), oSubjOutline, false)
oWText.insertControlCharacter(oWText.getEnd(), com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
End If
'
oArgs1(0).Name = "NumRule"
oArgs1(0).Value = "Numbering 1"
dispatcher.executeDispatch(document, ".uno:NumRule", "", 0, oArgs1())
'
oArgs2(0).Name = "LineNumber.CountLines"
oArgs2(0).Value = true
oArgs2(1).Name = "LineNumber.StartValue"
oArgs2(1).Value = 1
dispatcher.executeDispatch(document, ".uno:LineNumber", "", 0, oArgs2())
'
oArgs3(0).Name = "NumberingStart"
oArgs3(0).Value = true
dispatcher.executeDispatch(document, ".uno:NumberingStart", "", 0, oArgs3())
'
oOutlineText = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
"This line is first paragraph too. But it is second line." & Chr$(13) & _
"This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line." & Chr$(10)
oWText.insertString(oWText.getEnd(), oOutlineText, false)
next i
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 & Chr$(10) _
& " i = " & i, 0, "Error Message")
End Sub
WOt-)[Writer]Outline設定2b
Sub WriterOutline()
Dim oDoc as Object
Dim Dummy()
Dim document as Object
Dim dispatcher as Object
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
' Dispatcher
document = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
Dim oArgs1(0) as new com.sun.star.beans.PropertyValue
Dim oArgs2(1) as new com.sun.star.beans.PropertyValue
Dim oArgs3(0) as new com.sun.star.beans.PropertyValue
for i = 1 to 3
oWText = oDoc.getText()
If i = 1 then
oSubjOutline = "[ OutLine " & i & " ]"
oWText.insertString(oWText.getEnd(), oSubjOutline, false)
oWText.insertControlCharacter(oWText.getEnd(), com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
else
oSubjOutline = Chr$(10) & "[ OutLine " & i & " ]"
oWText.insertString(oWText.getEnd(), oSubjOutline, false)
oWText.insertControlCharacter(oWText.getEnd(), com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
End If
'
oArgs1(0).Name = "NumRule"
oArgs1(0).Value = "Numbering 1"
dispatcher.executeDispatch(document, ".uno:NumRule", "", 0, oArgs1())
'
oArgs2(0).Name = "LineNumber.CountLines"
oArgs2(0).Value = true
oArgs2(1).Name = "LineNumber.StartValue"
oArgs2(1).Value = 1
dispatcher.executeDispatch(document, ".uno:LineNumber", "", 0, oArgs2())
'
oArgs3(0).Name = "NumberingStart"
oArgs3(0).Value = false
dispatcher.executeDispatch(document, ".uno:NumberingStart", "", 0, oArgs3())
'
oOutlineText = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
"This line is first paragraph too. But it is second line." & Chr$(13) & _
"This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line." & Chr$(10)
oWText.insertString(oWText.getEnd(), oOutlineText, false)
next i
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 & Chr$(10) _
& " i = " & i, 0, "Error Message")
End Sub
WOt-)[Writer]Outline設定3a( 1 2 3 4 )
Sub WriterOutlineParagraph()
Dim oDoc
Dim oDText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oDText = oDoc.getText()
'
oCursor = nothing
' ここでは定義済みの番号付けスタイル Outline を利用。必要に応じて作成
oRule = nothing
oRules = oDoc.getNumberingRules()
For i = 0 To oRules.getCount() - 1 step 1
If oRules.getByIndex(i).Name = "Outline" Then
oRule = oRules.getByIndex(i)
Exit For
End If
Next
'
If IsNull(oRule) Then Exit sub
'
' 番号付けスタイルの表示形式を変更
' change numbering type
For i = 0 To oRule.getCount() - 1 step 1
oLevel = oRule.getByIndex(i)
n = FindItemIndex(oLevel, "NumberingType")
If n >= 0 Then
oItem = oLevel(n)
If oItem.Value = com.sun.star.style.NumberingType.NUMBER_NONE Then
oItem.Value = com.sun.star.style.NumberingType.ARABIC
oLevel(n) = oItem
oRule.replaceByIndex(i, oLevel)
End If
End If
Next
'
' 段落の挿入と段落に番号付けを設定
Dim oStrPar(3)
oStrPar(0) = "This line is first paragraph. This is first line."
oStrPar(1) = "This line is second paragraph. It is third line."
oStrPar(2) = "This line is third paragraph. It is fourth line."
oStrPar(3) = "This line is fourth paragraph. It is fifth line."
'
For i = 0 To UBound(oStrPar) step 1
oPara = oDText.appendParagraph(Array())
oCursor = oDText.createTextCursorByRange(oPara)
oDText.insertString(oCursor, oStrPar(i), False)
'
oCursor.ParaStyleName = "Heading 1"
oCursor.NumberingRules = oRule
Next
End Sub
'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
Dim nFound As Integer
nFound = -1
For i = 0 To UBound(aProps) step 1
If aProps(i).Name = sName Then
nFound = i
Exit For
End If
Next
FindItemIndex = nFound
End Function
WOt-)[Writer]Outline設定3b( A B C D )
Sub WriterOutlineParagraph()
Dim oDoc
Dim oDText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oDText = oDoc.getText()
'
oCursor = nothing
oRule = nothing
oRules = oDoc.getNumberingRules()
For i = 0 To oRules.getCount() - 1 step 1
If oRules.getByIndex(i).Name = "Outline" Then
oRule = oRules.getByIndex(i)
Exit For
End If
Next
'
If IsNull(oRule) Then Exit sub
'
' change numbering type
For i = 0 To oRule.getCount() - 1 step 1
oLevel = oRule.getByIndex(i)
n = FindItemIndex(oLevel, "NumberingType")
If n >= 0 Then
oItem = oLevel(n)
If oItem.Value = com.sun.star.style.NumberingType.NUMBER_NONE Then
oItem.Value = com.sun.star.style.NumberingType.CHARS_UPPER_LETTER
oLevel(n) = oItem
oRule.replaceByIndex(i, oLevel)
End If
End If
Next
'
' 段落の挿入と段落に番号付けを設定
Dim oStrPar(3)
oStrPar(0) = "This line is first paragraph. This is first line."
oStrPar(1) = "This line is second paragraph. It is third line."
oStrPar(2) = "This line is third paragraph. It is fourth line."
oStrPar(3) = "This line is fourth paragraph. It is fifth line."
'
For i = 0 To UBound(oStrPar) step 1
oPara = oDText.appendParagraph(Array())
oCursor = oDText.createTextCursorByRange(oPara)
oDText.insertString(oCursor, oStrPar(i), False)
'
oCursor.ParaStyleName = "Heading 1"
oCursor.NumberingRules = oRule
Next
End Sub
'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
Dim nFound As Integer
nFound = -1
For i = 0 To UBound(aProps) step 1
If aProps(i).Name = sName Then
nFound = i
Exit For
End If
Next
FindItemIndex = nFound
End Function
WOt-)[Writer]Outline設定3c( a b c d )
Sub WriterOutlineParagraph()
Dim oDoc
Dim oDText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oDText = oDoc.getText()
'
oCursor = nothing
oRule = nothing
oRules = oDoc.getNumberingRules()
For i = 0 To oRules.getCount() - 1 step 1
If oRules.getByIndex(i).Name = "Outline" Then
oRule = oRules.getByIndex(i)
Exit For
End If
Next
'
If IsNull(oRule) Then Exit sub
'
' change numbering type
For i = 0 To oRule.getCount() - 1 step 1
oLevel = oRule.getByIndex(i)
n = FindItemIndex(oLevel, "NumberingType")
If n >= 0 Then
oItem = oLevel(n)
If oItem.Value = com.sun.star.style.NumberingType.NUMBER_NONE Then
oItem.Value = com.sun.star.style.NumberingType.CHARS_LOWER_LETTER
oLevel(n) = oItem
oRule.replaceByIndex(i, oLevel)
End If
End If
Next
'
' 段落の挿入と段落に番号付けを設定
Dim oStrPar(3)
oStrPar(0) = "This line is first paragraph. This is first line."
oStrPar(1) = "This line is second paragraph. It is third line."
oStrPar(2) = "This line is third paragraph. It is fourth line."
oStrPar(3) = "This line is fourth paragraph. It is fifth line."
'
For i = 0 To UBound(oStrPar) step 1
oPara = oDText.appendParagraph(Array())
oCursor = oDText.createTextCursorByRange(oPara)
oDText.insertString(oCursor, oStrPar(i), False)
'
oCursor.ParaStyleName = "Heading 1"
oCursor.NumberingRules = oRule
Next
End Sub
'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
Dim nFound As Integer
nFound = -1
For i = 0 To UBound(aProps) step 1
If aProps(i).Name = sName Then
nFound = i
Exit For
End If
Next
FindItemIndex = nFound
End Function
WOt-)[Writer]Outline設定3d( ⅠⅡⅢⅣ )
Sub WriterOutlineParagraph()
Dim oDoc
Dim oDText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oDText = oDoc.getText()
'
oCursor = nothing
oRule = nothing
oRules = oDoc.getNumberingRules()
For i = 0 To oRules.getCount() - 1 step 1
If oRules.getByIndex(i).Name = "Outline" Then
oRule = oRules.getByIndex(i)
Exit For
End If
Next
'
If IsNull(oRule) Then Exit sub
'
' change numbering type
For i = 0 To oRule.getCount() - 1 step 1
oLevel = oRule.getByIndex(i)
n = FindItemIndex(oLevel, "NumberingType")
If n >= 0 Then
oItem = oLevel(n)
If oItem.Value = com.sun.star.style.NumberingType.NUMBER_NONE Then
oItem.Value = com.sun.star.style.NumberingType.ROMAN_UPPER
oLevel(n) = oItem
oRule.replaceByIndex(i, oLevel)
End If
End If
Next
'
' 段落の挿入と段落に番号付けを設定
Dim oStrPar(3)
oStrPar(0) = "This line is first paragraph. This is first line."
oStrPar(1) = "This line is second paragraph. It is third line."
oStrPar(2) = "This line is third paragraph. It is fourth line."
oStrPar(3) = "This line is fourth paragraph. It is fifth line."
'
For i = 0 To UBound(oStrPar) step 1
oPara = oDText.appendParagraph(Array())
oCursor = oDText.createTextCursorByRange(oPara)
oDText.insertString(oCursor, oStrPar(i), False)
'
oCursor.ParaStyleName = "Heading 1"
oCursor.NumberingRules = oRule
Next
End Sub
'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
Dim nFound As Integer
nFound = -1
For i = 0 To UBound(aProps) step 1
If aProps(i).Name = sName Then
nFound = i
Exit For
End If
Next
FindItemIndex = nFound
End Function
WOt-)[Writer]Outline設定3e( ⅰⅱⅲⅳ )
Sub WriterOutlineParagraph()
Dim oDoc
Dim oDText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oDText = oDoc.getText()
'
oCursor = nothing
oRule = nothing
oRules = oDoc.getNumberingRules()
For i = 0 To oRules.getCount() - 1 step 1
If oRules.getByIndex(i).Name = "Outline" Then
oRule = oRules.getByIndex(i)
Exit For
End If
Next
'
If IsNull(oRule) Then Exit sub
'
' change numbering type
For i = 0 To oRule.getCount() - 1 step 1
oLevel = oRule.getByIndex(i)
n = FindItemIndex(oLevel, "NumberingType")
If n >= 0 Then
oItem = oLevel(n)
If oItem.Value = com.sun.star.style.NumberingType.NUMBER_NONE Then
oItem.Value = com.sun.star.style.NumberingType.ROMAN_LOWER
oLevel(n) = oItem
oRule.replaceByIndex(i, oLevel)
End If
End If
Next
'
' 段落の挿入と段落に番号付けを設定
Dim oStrPar(3)
oStrPar(0) = "This line is first paragraph. This is first line."
oStrPar(1) = "This line is second paragraph. It is third line."
oStrPar(2) = "This line is third paragraph. It is fourth line."
oStrPar(3) = "This line is fourth paragraph. It is fifth line."
'
For i = 0 To UBound(oStrPar) step 1
oPara = oDText.appendParagraph(Array())
oCursor = oDText.createTextCursorByRange(oPara)
oDText.insertString(oCursor, oStrPar(i), False)
'
oCursor.ParaStyleName = "Heading 1"
oCursor.NumberingRules = oRule
Next
End Sub
'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
Dim nFound As Integer
nFound = -1
For i = 0 To UBound(aProps) step 1
If aProps(i).Name = sName Then
nFound = i
Exit For
End If
Next
FindItemIndex = nFound
End Function
WOt-)[Writer]Outline設定3f( 壱弐参四 )
Sub WriterOutlineParagraph()
Dim oDoc
Dim oDText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oDText = oDoc.getText()
'
oCursor = nothing
oRule = nothing
oRules = oDoc.getNumberingRules()
For i = 0 To oRules.getCount() - 1 step 1
If oRules.getByIndex(i).Name = "Outline" Then
oRule = oRules.getByIndex(i)
Exit For
End If
Next
'
If IsNull(oRule) Then Exit sub
'
' change numbering type
For i = 0 To oRule.getCount() - 1 step 1
oLevel = oRule.getByIndex(i)
n = FindItemIndex(oLevel, "NumberingType")
If n >= 0 Then
oItem = oLevel(n)
If oItem.Value = com.sun.star.style.NumberingType.NUMBER_NONE Then
oItem.Value = com.sun.star.style.NumberingType.NUMBER_TRADITIONAL_JA
oLevel(n) = oItem
oRule.replaceByIndex(i, oLevel)
End If
End If
Next
'
' 段落の挿入と段落に番号付けを設定
Dim oStrPar(3)
oStrPar(0) = "This line is first paragraph. This is first line."
oStrPar(1) = "This line is second paragraph. It is third line."
oStrPar(2) = "This line is third paragraph. It is fourth line."
oStrPar(3) = "This line is fourth paragraph. It is fifth line."
'
For i = 0 To UBound(oStrPar) step 1
oPara = oDText.appendParagraph(Array())
oCursor = oDText.createTextCursorByRange(oPara)
oDText.insertString(oCursor, oStrPar(i), False)
'
oCursor.ParaStyleName = "Heading 1"
oCursor.NumberingRules = oRule
Next
End Sub
'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
Dim nFound As Integer
nFound = -1
For i = 0 To UBound(aProps) step 1
If aProps(i).Name = sName Then
nFound = i
Exit For
End If
Next
FindItemIndex = nFound
End Function
WOt-)[Writer]Outline設定3g( アイウエ )
Sub WriterOutlineParagraph()
Dim oDoc
Dim oDText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oDText = oDoc.getText()
'
oCursor = nothing
oRule = nothing
oRules = oDoc.getNumberingRules()
For i = 0 To oRules.getCount() - 1 step 1
If oRules.getByIndex(i).Name = "Outline" Then
oRule = oRules.getByIndex(i)
Exit For
End If
Next
'
If IsNull(oRule) Then Exit sub
'
' change numbering type
For i = 0 To oRule.getCount() - 1 step 1
oLevel = oRule.getByIndex(i)
n = FindItemIndex(oLevel, "NumberingType")
If n >= 0 Then
oItem = oLevel(n)
If oItem.Value = com.sun.star.style.NumberingType.NUMBER_NONE Then
oItem.Value = com.sun.star.style.NumberingType.AIU_FULLWIDTH_JA
oLevel(n) = oItem
oRule.replaceByIndex(i, oLevel)
End If
End If
Next
'
' 段落の挿入と段落に番号付けを設定
Dim oStrPar(3)
oStrPar(0) = "This line is first paragraph. This is first line."
oStrPar(1) = "This line is second paragraph. It is third line."
oStrPar(2) = "This line is third paragraph. It is fourth line."
oStrPar(3) = "This line is fourth paragraph. It is fifth line."
'
For i = 0 To UBound(oStrPar) step 1
oPara = oDText.appendParagraph(Array())
oCursor = oDText.createTextCursorByRange(oPara)
oDText.insertString(oCursor, oStrPar(i), False)
'
oCursor.ParaStyleName = "Heading 1"
oCursor.NumberingRules = oRule
Next
End Sub
'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
Dim nFound As Integer
nFound = -1
For i = 0 To UBound(aProps) step 1
If aProps(i).Name = sName Then
nFound = i
Exit For
End If
Next
FindItemIndex = nFound
End Function
WOt-)[Writer]Outline設定3h( ァイゥェ )
Sub WriterOutlineParagraph()
Dim oDoc
Dim oDText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oDText = oDoc.getText()
'
oCursor = nothing
oRule = nothing
oRules = oDoc.getNumberingRules()
For i = 0 To oRules.getCount() - 1 step 1
If oRules.getByIndex(i).Name = "Outline" Then
oRule = oRules.getByIndex(i)
Exit For
End If
Next
'
If IsNull(oRule) Then Exit sub
'
' change numbering type
For i = 0 To oRule.getCount() - 1 step 1
oLevel = oRule.getByIndex(i)
n = FindItemIndex(oLevel, "NumberingType")
If n >= 0 Then
oItem = oLevel(n)
If oItem.Value = com.sun.star.style.NumberingType.NUMBER_NONE Then
oItem.Value = com.sun.star.style.NumberingType.AIU_HALFWIDTH_JA
oLevel(n) = oItem
oRule.replaceByIndex(i, oLevel)
End If
End If
Next
'
' 段落の挿入と段落に番号付けを設定
Dim oStrPar(3)
oStrPar(0) = "This line is first paragraph. This is first line."
oStrPar(1) = "This line is second paragraph. It is third line."
oStrPar(2) = "This line is third paragraph. It is fourth line."
oStrPar(3) = "This line is fourth paragraph. It is fifth line."
'
For i = 0 To UBound(oStrPar) step 1
oPara = oDText.appendParagraph(Array())
oCursor = oDText.createTextCursorByRange(oPara)
oDText.insertString(oCursor, oStrPar(i), False)
'
oCursor.ParaStyleName = "Heading 1"
oCursor.NumberingRules = oRule
Next
End Sub
'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
Dim nFound As Integer
nFound = -1
For i = 0 To UBound(aProps) step 1
If aProps(i).Name = sName Then
nFound = i
Exit For
End If
Next
FindItemIndex = nFound
End Function
WOt-)[Writer](未完成)Outline設定
Sub oOutlineInWrite
Dim oDoc
Dim oDText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'
Dim oRules
Dim oRule()
Dim oProp
Dim oNames(0)
oNames(0) = "_New_Heading_1"
oRules = oDoc.getChapterNumberingRules()
For i = 0 To UBound(oNames())
If i >= oRules.getCount() Then Exit Sub
oRule() = oRules.getByIndex(i)
For j = LBound(oRule()) To Ubound(oRule())
oProp = oRule(j)
Select Case oProp.Name
Case "HeadingStyleName"
oProp.Value = oNames(i)
Case "NumberingType"
oProp.Value = com.sun.star.style.NumberingType.ARABIC
Case "ParentNumbering"
oProp.Value = i + 1
Case "Prefix"
oProp.Value = ""
Case "Suffix"
oProp.Value = " "
End Select
oRule(j) = oProp
Next j
oRules.replaceByIndex(i, oRule())
Next i
'
Dim oFamilies
Dim oParaStyles
Dim oStyle
oFamilies = oDoc.StyleFamilies
oParaStyles = oFamilies.getByName("ParagraphStyles")
'
oStyle = oDoc.createInstance("com.sun.star.style.ParagraphStyle")
oStyle.setParentStyle("Heading")
'
oStyle.CharHeight = 20
oParaStyles.insertByName(oNames(0), oStyle)
'
oDText = oDoc.getText()
oDisp = "This line is first paragraph. This is first line." & Chr$(13) & _
"This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line." & Chr$(13) & _
"This line is fourth paragraph. It is fifth line."
oDText.insertString(oDText.getEnd(), oDisp, true)
End Sub
WOt-)[Writer]
Sort
WSort-)[Writer](未完成)Sort in writer
Sub oSortTextInWrite
Dim oDoc
Dim oDText
Dim oText 'Text object for the current object
Dim oVCursor 'Current view cursor
Dim oCursor 'Text cursor
Dim oSort
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oDText = oDoc.getText()
oDisp = "This line is first paragraph. This is first line." & Chr$(13) & _
"This line is second paragraph. It is third line." & Chr$(13) & _
"This line is third paragraph. It is fourth line." & Chr$(13) & _
"This line is fourth paragraph. It is fifth line."
oDText.insertString(oDText.getEnd(), oDisp, false)
'
oVCursor = oDoc.getCurrentController().getViewCursor()
oText = oVCursor.getText()
oCursor = oText.createTextCursorByRange(oVCursor)
oSort = oCursor.createSortDescriptor()
'
oCursor.sort(oSort)
End Sub
WSort-)[Writer]
Printer
WP-)[Writer]PagePrintProperties
Sub oDisplayPagePrintProperties
Dim oprops as Object
Dim i%
Dim oDisp
On Error Goto oBad
oDoc = ThisComponent
ouno = "com.sun.star.text.XPagePrintable"
'get File Name
oURL = oDoc.getURL()
oName = COnvertFromUrl(oURL)
oDisp = "[ " & oName & " ]" & Chr$(10) & Chr$(10)
'get Page Print Properties
If HasUnoInterfaces(oDoc,ouno) then
oprops = oDOc.getPagePrintSettings()
for i = 0 to UBound(oprops)
oDisp = oDisp & oprops(i).Name & " = "
oDisp = oDisp & CStr(oprops(i).Value)
oDisp = oDisp & Chr$(10)
next i
msgbox(oDisp , 0, "Page Print Properties")
else
msgbox("This Document does not support" & Chr$(10) & _
"the XpagePrintable interface",0,"Caution!!")
End If
Exit Sub
oBad:
mErr = Error
msgbox(mErr & " : i = " & i )
End Sub
WP-)[Writer]2列割pageの印刷1
Sub oDisplayPagePrintProperties
Dim oprops(0 to 1) as New com.sun.star.beans.PropertyValue
Dim i%
Dim oDisp
On Error Goto oBad
oDoc = ThisComponent
ouno = "com.sun.star.text.XPagePrintable"
'set Page Print Properties
oprops(0).Name = "PageColumns"
oprops(0).Value = 2
oprops(1).Name = "IsLandscape"
oprops(1).Value = true
If HasUnoInterfaces(oDoc,ouno) then
oDoc.setPagePrintSettings(oprops())
oDoc.printPages(Array())
else
msgbox("This Document does not support" & Chr$(10) & _
"the XpagePrintable interface",0,"Caution!!")
End If
Exit Sub
oBad:
mErr = Error
lErr =Erl
msgbox(mErr & " : i = " & i & Chr$(10) & "Error Line = " &lErr )
End Sub
WP-)[Writer]2列割pageの印刷2
Sub oPrintTwoCloumnPerPage2
Dim osettings
Dim oset
Dim i%
On Error Goto oBad
oDoc = ThisComponent
'set Page Print Properties
osettings = oDoc.getPagePrintSettings()
oset = osettings(1)
for i = LBound(osettings) to UBound(osettings)
oset = osettings(i)
If oset.name = "PageColumns" then
oset.value = 2
osettings(i) = oset
End If
If oset.name = "IsLandscape" then
oset.value = true
osettings(i) = oset
End If
next i
oDoc.printPages(osettings)
Exit Sub
oBad:
mErr = Error
lErr =Erl
msgbox(mErr & " : i = " & i & Chr$(10) & "Error Line = " &lErr )
End Sub
WP-)[Writer]
Shape[Writer]
WS-)[Writer](未完成)Document中のShape抽出
Sub oShapeinWriter ' 未完成
Dim oDrawPage
Dim oShape
Dim i%
Dim sGroupShape
Dim sControlShape
sGroupShape = "com.sun.star.drawing.GroupShape"
sControlShape = "com.sun.star.drawing.ControlShape"
'oDrawPage = ThisComponent.getDrawPage() ': print oDrawPage.getCount
oDoc = ThisComponent
a = oDoc.supportsService(sControlShape)
b = oDoc.supportsService("com.sun.star.drawing.GenericDrawPage")
print b
End Sub
Form
WFm-)[Writer]ComboBox作成
Sub oPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
'
Dim oList(5) as String
oList(0) = "Zero"
oList(1) = "One"
oList(2) = "Two"
oList(3) = "Three"
oList(4) = "Four"
oList(5) = "Five"
'
'
Dim oControlShape as Object
Dim oControlModel as Object
'
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
positionShape( oControlShape, 1000, 1000 , 5000, 600 )
' a control model
' Combo Box
oControlModel = oDoc.createInstance("com.sun.star.form.component.ComboBox")
oControlModel.Name = "NumberSelection"
oControlModel.Text = "Zero"
oControlModel.Dropdown = True
oControlModel.StringItemList = oList()
'
oSampleForm.insertByIndex( 0, oControlModel )
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
End Sub
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]ComboBox値取得
Sub oGetPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
'
Dim oList(5) as String
oList(0) = "Zero"
oList(1) = "One"
oList(2) = "Two"
oList(3) = "Three"
oList(4) = "Four"
oList(5) = "Five"
'
'
Dim oControlShape as Object
Dim oControlModel as Object
'
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
oGetPositionShape( oControlShape, 1000, 1000 , 5000, 600 )
' a control model
' Combo Box
oControlModel = oDoc.createInstance("com.sun.star.form.component.ComboBox")
oControlModel.Name = "NumberSelection"
oControlModel.Text = "Two"
oControlModel.Dropdown = True
oControlModel.StringItemList = oList()
oSampleForm.insertByIndex( 0, oControlModel )
oControlModel.StringItemList = oList()
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
'
' 値の取得
Dim oPForm as Object
Dim oPFCtrlM as Object
Dim oSelectItem as String
Dim oDisp as String
Dim i as Integer
oPForm = oFormsCollection.getByIndex(0)
oPFCtrlM = oPForm.getControlModels()
for i = 0 to UBound(oPFCtrlM)
oSelectItem = oPFCtrlM(i).Text
' oSelectItem = oPFCtrlM(i).CurrentValue ' こちらでも取得できる。
oDisp = oDisp & oSelectItem & Chr$(10)
next i
' Display
msgbox(oDisp, 0, "ComboBox選択項目")
End Sub
Sub oGetPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]ListBox作成
Sub oPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
'
Dim oList(5) as String
oList(0) = "Zero"
oList(1) = "One"
oList(2) = "Two"
oList(3) = "Three"
oList(4) = "Four"
oList(5) = "Five"
'
'
Dim oControlShape as Object
Dim oControlModel as Object
'
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
positionShape( oControlShape, 1000, 1000 , 2000, 3000 )
' ControlShape
oControlModel = oDoc.createInstance("com.sun.star.form.component.ListBox")
oControlModel.reset()
oControlModel.commit()
oControlModel.refresh()
oControlModel.DropDown = false ' DropDown表示 MultiSelect => trueならば falseにする
oControlModel.Enabled = True
oControlModel.Name = "NumberSelection"
oControlModel.MultiSelection = true ' 複数選択
oControlModel.BackgroundColor = &HC8FFB9 'verdolino
oControlModel.FontHeight = 12
oControlModel.FontWeight = com.sun.star.awt.FontWeight.BOLD
oControlModel.LineCount = 6 ' 表示する項目数
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
'
'add thelist items to the listbox
Dim frm as Object
Dim oListBoxModel as Object
Dim ctrl as Object
Dim oListBoxView as Object
frm=oFormsCollection.getByIndex(0)
oListBoxModel=frm.getByName("NumberSelection")
ctrl = oDoc.CurrentController
oListBoxView = ctrl.getControl(oListBoxModel)
oListBoxView.addItems(oList, 0, 1, 2, 3, 4, 5)
oListBoxView.selectItemPos(0,false)
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
End Sub
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]ListBox値取得
Sub oGetPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
'
Dim oList(5) as String
oList(0) = "Zero"
oList(1) = "One"
oList(2) = "Two"
oList(3) = "Three"
oList(4) = "Four"
oList(5) = "Five"
'
'
Dim oControlShape as Object
Dim oControlModel as Object
'
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
oGetPositionShape( oControlShape, 1000, 1000 , 2000, 3000 )
' ControlShape / ListBox
oControlModel = oDoc.createInstance("com.sun.star.form.component.ListBox")
oControlModel.reset()
oControlModel.commit()
oControlModel.refresh()
oControlModel.DropDown = false ' DropDown表示 MultiSelect => trueならば falseにする
oControlModel.Enabled = True
oControlModel.Name = "NumberSelection"
oControlModel.MultiSelection = true ' 複数選択
oControlModel.BackgroundColor = &HC8FFB9 'verdolino
oControlModel.FontHeight = 12
oControlModel.FontWeight = com.sun.star.awt.FontWeight.BOLD
oControlModel.LineCount = 6 ' 表示する項目数
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
'
'add thelist items to the listbox
Dim frm as Object
Dim oListBoxModel as Object
Dim ctrl as Object
Dim oListBoxView as Object
frm=oFormsCollection.getByIndex(0)
oListBoxModel=frm.getByName("NumberSelection")
ctrl = oDoc.CurrentController
oListBoxView = ctrl.getControl(oListBoxModel)
oListBoxView.addItems(oList, 0, 1, 2, 3, 4, 5)
oListBoxView.selectItemPos(1,true) ' 初期設定 0を選択(falseで選択無し)
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
'
' 値の取得
Dim oPForm as Object
Dim oPFEltCount as Long
Dim oPFElement as Object
Dim oSelectItem as Object
Dim i ,j as Integer
Dim oDisp as String
oPForm = oFormsCollection.getByIndex(0)
oPFEltCount = oPForm.getCount()
If oPFEltCount < 1 then
oDisp = "項目が選択されていません。"
msgbox(oDisp, 0, "ListBoxの項目")
Exit Sub
End If
oDisp = ""
for i = 0 to oPFEltCount-1
oPFElement = oPForm.getByIndex(i)
oSelectItem = oPFElement.getCurrentValue()
for j = 0 to UBound(oSelectItem)
oDisp = oDisp & oSelectItem(j) & Chr(10)
next j
next i
msgbox(oDisp, 0, "ListBox 選択されている項目")
End Sub
'
Sub oGetPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
'
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]CheckBox作成
Sub oPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
'
Dim oList(5) as String
oList(0) = "Zero"
oList(1) = "One"
oList(2) = "Two"
oList(3) = "Three"
oList(4) = "Four"
oList(5) = "Five"
'
'
Dim oControlShape as Object
Dim oControlModel as Object
'
Dim i as Integer
For i = 0 To 5
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
positionShape( oControlShape, 1000, 1000 + i * 800, 5000, 600 )
'
' a control model
oControlModel = createUnoService( "com.sun.star.form.component.CheckBox" )
oControlModel.Name = "Number"
oControlModel.Label = UCase( oList( i ) )
oControlModel.Tag = oList( i )
If i = 1 or i = 3 then
oControlModel.State = 1
End If
oSampleForm.insertByIndex( i, oControlModel )
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
Next i
'
' set the focus to the first control
oDoc.CurrentController.getControl( oSampleForm.getByIndex( 0 ) ).setFocus
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
End Sub
'
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
'
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]CheckBox値取得
Sub oGetPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
Dim oList(5) as String
oList(0) = "Zero"
oList(1) = "One"
oList(2) = "Two"
oList(3) = "Three"
oList(4) = "Four"
oList(5) = "Five"
'
Dim oControlShape as Object
Dim oControlModel as Object
'
Dim i as Integer
For i = 0 To 5
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
positionShape( oControlShape, 1000, 1000 + i * 800, 5000, 600 )
'
' a control model
oControlModel = createUnoService( "com.sun.star.form.component.CheckBox" )
oControlModel.Name = "Number"
oControlModel.Label = UCase( oList( i ) )
oControlModel.Tag = oList( i )
If i = 1 or i = 3 then
oControlModel.State = 1
End If
oSampleForm.insertByIndex( i, oControlModel )
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
Next i
'
' set the focus to the first control
oDoc.CurrentController.getControl( oSampleForm.getByIndex( 0 ) ).setFocus
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
'
' 値の取得
Dim oPForm as Object
Dim oPFEltCount as Long
Dim oPFElement as Object
Dim oRButtonOnOff as Integer
Dim oSelectItem as String
Dim oDisp as String
oPForm = oFormsCollection.getByIndex(0)
oPFEltCount = oPForm.getCount()
oDisp = ""
for i = 0 to oPFEltCount - 1
oPFElement = oPForm.getByIndex(i)
If oPFElement.supportsService("com.sun.star.form.component.CheckBox") then
oRButtonOnOff = oPFElement.State
If oRButtonOnOff = 1 then
oSelectItem = oPFElement.Label
oDisp = oDisp & oSelectItem & Chr$(10)
End If
End If
next i
' Display
msgbox(oDisp, 0, "CheckBox選択Item")
End Sub
'
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
'
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]GroupBox(CheckBox)値取得
Sub oPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
'
Dim oList(5) as String
oList(0) = "Zero"
oList(1) = "One"
oList(2) = "Two"
oList(3) = "Three"
oList(4) = "Four"
oList(5) = "Five"
'
' **** [ GroupBox ] ****
Dim oGroup as Object
Dim oShapeGr as Object
Dim oControlModelGr as Object
oGroup = createUnoService("com.sun.star.drawing.ShapeCollection")
oShapeGr = oDoc.createInstance("com.sun.star.drawing.ControlShape")
positionShape( oShapeGr, 500, 200, 2500, 5500 )
'
oControlModelGr = oDoc.createInstance("com.sun.star.form.component.GroupBox")
oControlModelGr.Name = "グループボックス 1"
oControlModelGr.Label = "GroupBox1"
'
oShapeGr.Control = oControlModelGr
oSampleForm.insertByIndex( 0, oControlModelGr )
oDoc.DrawPage.add( oShapeGr )
oGroup.add( oShapeGr )
' *******************
'
Dim oControlShape as Object
Dim oControlModel as Object
Dim i as Integer
For i = 0 To 5
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
positionShape( oControlShape, 1000, 1000 + i * 800, 5000, 600 )
'
' a control model
oControlModel = createUnoService( "com.sun.star.form.component.CheckBox" )
oControlModel.Name = "Number"
oControlModel.Label = UCase( oList( i ) )
If i = 2 or i= 3 or i = 5 then
oControlModel.State = 1
End If
oControlModel.Tag = oList( i )
oSampleForm.insertByIndex( i, oControlModel )
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
Next i
'
'
' set the focus to the first control
oDoc.CurrentController.getControl( oSampleForm.getByIndex( 0 ) ).setFocus
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
'
' 値の取得
Dim oPForm as Object
Dim oPFEltCount as Long
Dim oPFElement as Object
Dim oRButtonOnOff as Integer
Dim oSelectItem as String
Dim oDisp as String
oPForm = oFormsCollection.getByIndex(0)
oPFEltCount = oPForm.getCount()
oDisp = ""
for i = 0 to oPFEltCount - 1
oPFElement = oPForm.getByIndex(i)
If oPFElement.supportsService("com.sun.star.form.component.CheckBox") then
oRButtonOnOff = oPFElement.State
If oRButtonOnOff = 1 then
oSelectItem = oPFElement.Label
oDisp = oDisp & oSelectItem & Chr$(10)
End If
End If
next i
' Display
msgbox(oDisp, 0, "GroupBox選択Item")
End Sub
'
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
'
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]RadioButton作成
Sub oPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
'
Dim oList(5) as String
oList(0) = "Zero"
oList(1) = "One"
oList(2) = "Two"
oList(3) = "Three"
oList(4) = "Four"
oList(5) = "Five"
'
'
Dim oControlShape as Object
Dim oControlModel as Object
'
Dim i as Integer
For i = 0 To 5
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
positionShape( oControlShape, 1000, 1000 + i * 800, 5000, 600 )
'
' a control model
oControlModel = createUnoService( "com.sun.star.form.component.RadioButton" )
oControlModel.Name = "Number"
oControlModel.Label = UCase( oList( i ) )
oControlModel.Tag = oList( i )
oSampleForm.insertByIndex( i, oControlModel )
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
Next i
'
' set the focus to the first control
oDoc.CurrentController.getControl( oSampleForm.getByIndex( 0 ) ).setFocus
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
End Sub
'
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
'
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]GroupBox(RadioButton)作成
Sub oPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
'
Dim oList(5) as String
oList(0) = "Zero"
oList(1) = "One"
oList(2) = "Two"
oList(3) = "Three"
oList(4) = "Four"
oList(5) = "Five"
'
' **** [ GroupBox ] ****
Dim oGroup as Object
Dim oShapeGr as Object
Dim oControlModelGr as Object
oGroup = createUnoService("com.sun.star.drawing.ShapeCollection")
oShapeGr = oDoc.createInstance("com.sun.star.drawing.ControlShape")
positionShape( oShapeGr, 500, 200, 2500, 5500 )
'
oControlModelGr = oDoc.createInstance("com.sun.star.form.component.GroupBox")
oControlModelGr.Name = "グループボックス 1"
oControlModelGr.Label = "GroupBox1"
'
oShapeGr.Control = oControlModelGr
oSampleForm.insertByIndex( 0, oControlModelGr )
oDoc.DrawPage.add( oShapeGr )
oGroup.add( oShapeGr )
' *******************
'
Dim oControlShape as Object
Dim oControlModel as Object
Dim i as Integer
For i = 0 To 5
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
positionShape( oControlShape, 1000, 1000 + i * 800, 5000, 600 )
'
' a control model
oControlModel = createUnoService( "com.sun.star.form.component.RadioButton" )
oControlModel.Name = "Number"
oControlModel.Label = UCase( oList( i ) )
If i = 3 then
oControlModel.State = 1
End If
oControlModel.Tag = oList( i )
oSampleForm.insertByIndex( i, oControlModel )
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
Next i
'
'
' set the focus to the first control
oDoc.CurrentController.getControl( oSampleForm.getByIndex( 0 ) ).setFocus
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
End Sub
'
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
'
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]GroupBox(RadioButton)値取得
Sub oPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
'
Dim oList(5) as String
oList(0) = "Zero"
oList(1) = "One"
oList(2) = "Two"
oList(3) = "Three"
oList(4) = "Four"
oList(5) = "Five"
'
' **** [ GroupBox ] ****
Dim oGroup as Object
Dim oShapeGr as Object
Dim oControlModelGr as Object
oGroup = createUnoService("com.sun.star.drawing.ShapeCollection")
oShapeGr = oDoc.createInstance("com.sun.star.drawing.ControlShape")
positionShape( oShapeGr, 500, 200, 2500, 5500 )
'
oControlModelGr = oDoc.createInstance("com.sun.star.form.component.GroupBox")
oControlModelGr.Name = "グループボックス 1"
oControlModelGr.Label = "GroupBox1"
'
oShapeGr.Control = oControlModelGr
oSampleForm.insertByIndex( 0, oControlModelGr )
oDoc.DrawPage.add( oShapeGr )
oGroup.add( oShapeGr )
' *******************
'
Dim oControlShape as Object
Dim oControlModel as Object
Dim i as Integer
For i = 0 To 5
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
positionShape( oControlShape, 1000, 1000 + i * 800, 5000, 600 )
'
' a control model
oControlModel = createUnoService( "com.sun.star.form.component.RadioButton" )
oControlModel.Name = "Number"
oControlModel.Label = UCase( oList( i ) )
If i = 3 then
oControlModel.State = 1
End If
oControlModel.Tag = oList( i )
oSampleForm.insertByIndex( i, oControlModel )
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
Next i
'
'
' set the focus to the first control
oDoc.CurrentController.getControl( oSampleForm.getByIndex( 0 ) ).setFocus
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
'
' 値の取得
Dim oPForm as Object
Dim oPFEltCount as Long
Dim oPFElement as Object
Dim oRButtonOnOff as Integer
Dim oSelectItem as String
Dim oDisp as String
oPForm = oFormsCollection.getByIndex(0)
oPFEltCount = oPForm.getCount()
oDisp = ""
for i = 0 to oPFEltCount - 1
oPFElement = oPForm.getByIndex(i)
If oPFElement.supportsService("com.sun.star.form.component.RadioButton") then
oRButtonOnOff = oPFElement.State
If oRButtonOnOff = 1 then
oSelectItem = oPFElement.Label
oDisp = oDisp & oSelectItem & Chr$(10)
End If
End If
next i
' Display
msgbox(oDisp, 0, "GroupBox選択Item")
End Sub
'
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
'
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]TextBox作成
Sub oGetPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
Dim oControlShape as Object
Dim oControlModel as Object
'
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
oGetPositionShape( oControlShape, 1000, 1000 , 1500, 1000 )
' a control model
' Text Box
oControlModel = oDoc.createInstance("com.sun.star.form.component.TextField")
oControlModel.BackgroundColor = 14540253
oControlModel.Border = 1
oControlModel.DataField = "NAME"
'
' Dim oLControl(0) as New com.sun.star.beans.PropertyValue
' oLControl(0).Name = "Label"
' oLControl(0).Value = "Label_value"
' oControlModel.LabelControl = oLControl ' Comment部を追加してもLabel Fieldの設定はされない。
oControlModel.Name = "txtNAME"
oControlModel.MultiLine = True
oControlModel.Align = 0
oControlModel.ReadOnly = false
oControlModel.VScroll = true
oControlModel.HScroll = true
'
oSampleForm.insertByIndex( 0, oControlModel )
' Set Text
oControlModel.String = "LibreOffice" & Chr$(10) & "Apache OpenOffice"
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
'
msgbox "Success"
End Sub
Sub oGetPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]TextBox値取得
Sub oGetPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
Dim oControlShape as Object
Dim oControlModel as Object
'
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
oGetPositionShape( oControlShape, 1000, 1000 , 5000, 600 )
' a control model
' Text Box
oControlModel = oDoc.createInstance("com.sun.star.form.component.TextField")
oControlModel.BackgroundColor = 14540253
oControlModel.Border = 1
oControlModel.DataField = "NAME"
' REM oControlModel.LabelControl = oLControl
oControlModel.Name = "txtNAME"
oControlModel.MultiLine = True
oControlModel.Align = 0
oControlModel.ReadOnly = false
'
oSampleForm.insertByIndex( 0, oControlModel )
' Set Text
oControlModel.String = "LibreOffice Macro"
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
'
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
'
' 値の取得
Dim oPForm as Object
Dim oPFCtrlM as Object
Dim oTextBoxName as String
Dim oTextVal as String
Dim oDisp as String
Dim i as Integer
oPForm = oFormsCollection.getByIndex(0)
oPFCtrlM = oPForm.getControlModels()
' TextBoxの指定
for i = 0 to UBound(oPFCtrlM)
oTextBoxName = oPFCtrlM( i ).Name
if oTextBoxName = "txtNAME" then
' TextBox値取得
oTextVal = oPFCtrlM( i ).Text
' oTextVal = oPFCtrlM( i ).CurrentValue ' こちらでも取得できる。
End If
next i
'
oDisp = "Text Boxの値 = " & oTextVal
' Display
msgbox(oDisp, 0, "TextBoxの値")
End Sub
'
Sub oGetPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
'
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]TextBoxのControl変更
Sub oGetPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
Dim oControlShape as Object
Dim oControlModel as Object
'
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
oGetPositionShape( oControlShape, 1000, 1000 , 3000, 2000 )
' a control model
' Text Box
oControlModel = oDoc.createInstance("com.sun.star.form.component.TextField")
oControlModel.BackgroundColor = 14540253
oControlModel.Border = 1
oControlModel.DataField = "NAME"
' REM oControlModel.LabelControl = oLControl
oControlModel.Name = "txtNAME"
oControlModel.MultiLine = True
oControlModel.Align = 0
oControlModel.ReadOnly = false
oControlModel.VScroll = true
oControlModel.HScroll = true
'
oSampleForm.insertByIndex( 0, oControlModel )
' Set Text
oControlModel.String = "LibreOffice Macro"
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
'
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
'
' 値の取得
Dim oPForm as Object
Dim oPFCtrlM as Object
Dim oTextBoxName as String
Dim oTextVal as String
Dim oDisp as String
Dim i as Integer
oPForm = oFormsCollection.getByIndex(0)
oPFCtrlM = oPForm.getControlModels()
' TextBoxの指定
for i = 0 to UBound(oPFCtrlM)
oTextBoxName = oPFCtrlM( i ).Name
if oTextBoxName = "txtNAME" then
' TextBox値取得
oTextVal = oPFCtrlM( i ).Text
' oTextVal = oPFCtrlM( i ).CurrentValue ' こちらでも取得できる。
End If
next i
'
oDisp = "Text Boxの値 = " & oTextVal
' Display
msgbox(oDisp, 0, "TextBoxの値")
'
' Text Box の Cntrol 値の変更
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = true
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
'
oPForm = oFormsCollection.getByIndex(0)
oPFCtrlM = oPForm.getControlModels()
' TextBoxの指定
for i = 0 to UBound(oPFCtrlM)
oTextBoxName = oPFCtrlM( i ).Name
if oTextBoxName = "txtNAME" then
' Scroll Bar を非表示にする
oPFCtrlM( i ).VScroll = false
oPFCtrlM( i ).HScroll = false
End If
next i
'
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
'
msgbox "Success"
End Sub
'
Sub oGetPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
'
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]Command Button作成
Sub oPShapeControll
Dim oDoc as Object
oDoc = ThisComponent
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
'
Dim oControlShape as Object
Dim oControlModel as Object
'
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
positionShape( oControlShape, 1000, 1000 , 2000, 1000 )
'
' a control model / Formを削除する時はFormを削除しても Control Modelは残るので、別途削除Codeが必要
' Command Bottun
oControlModel = oDoc.createInstance("com.sun.star.form.component.CommandButton")
oControlModel.Label = "Push !!"
oControlModel.Enabled = True
oControlModel.Printable = False
oControlModel.Name = "CmdBtn"
oControlModel.Tag = "CmdbtnTag"
'
' knit both
oControlShape.Control = oControlModel
'
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
'
' Command Button にmacroを設定
Dim oMacroName as String
Dim oListener as Object
Dim oEvent as Object
Dim oForm as Object
Dim oId as Long
'
oMacroName = "oComandBtn"
'
oEvent = createUnoStruct("com.sun.star.script.ScriptEventDescriptor")
oEvent.ListenerType = "XActionListener"
oEvent.EventMethod = "actionPerformed"
oEvent.ScriptType = "Script"
oEvent.ScriptCode = "vnd.sun.star.script:Library1.Module1." & oMacroName & "?language=Basic&location=document"
'
oForm = oDoc.DrawPage.getForms().getByIndex(0)
oId = oForm.getCount() -1
'
oForm.registerScriptEvent(oId, oEvent)
'
'
' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
Dim oFrame as object
Dim dispatcher as object
oFrame = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
Dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
'
msgbox "Success"
End Sub
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
'
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
'
Sub oComandBtn()
msgbox "Command Botton" & Chr$(10) & "が押されました。",0,"Command Button"
End Sub
'
' [ 注意 ]
' 本Macro は document / Library1 / Module1 に 記述している。
WFm-)[Writer]RichTextBox作成
Sub oGetPShapeControll
Dim oDoc as Object
Dim Dummy()
oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
'
' create a new logical form
Dim oFormsCollection as Object
oFormsCollection = oDoc.DrawPage.Forms
Dim oSampleForm as Object
oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
oFormsCollection.insertByName( "sample form", oSampleForm )
'
Dim oControlShape as Object
Dim oControlModel as Object
'
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
oGetPositionShape( oControlShape, 1000, 1000 , 6000, 3000 )
' a control model
' Rich Text Box
oControlModel = oDoc.createInstance("com.sun.star.form.component.RichTextControl")
oControlModel.RichText = True
oControlModel.BackgroundColor = 14540253
oControlModel.Align = 0
oControlModel.Border = 1
REM oControlModel.DataField = "NAME_Rich" ' Data FieldとしてRich Textは無い。つまりBaseのFormには使えない？
oControlModel.MultiLine = True
oControlModel.Name = "rthNAME"
oControlModel.ReadOnly = false
'
oSampleForm.insertByIndex( 0, oControlModel )
' Set Text
oControlModel.String = "[ Ritch Text Box ]"
'
' knit both
oControlShape.Control = oControlModel
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
'
' a shape
oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
oGetPositionShape( oControlShape, 1000, 5000 , 6000, 3000 )
' a control model
' Text Box
oControlModel = oDoc.createInstance("com.sun.star.form.component.TextField")
oControlModel.BackgroundColor = 14540253
oControlModel.Align = 0
oControlModel.Border = 1
oControlModel.DataField = "NAME_Text"
oControlModel.MultiLine = True
oControlModel.Name = "txtNAME"
oControlModel.ReadOnly = false
'
oSampleForm.insertByIndex( 0, oControlModel )
' Set Text
oControlModel.String = "[ Text Box ]"
'
' knit both
oControlShape.Control = oControlModel
' add the shape to the DrawPage
oDoc.DrawPage.add( oControlShape )
'
' add the shape to the DrawPage
msgbox "Success"
End Sub
Sub oGetPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
'
Dim oPos as new com.sun.star.awt.Point
oPos.X = X
oPos.Y = Y
oShape.setPosition( oPos )
Erase oPos
Dim oSize as new com.sun.star.awt.Size
oSize.Width = Width
oSize.Height = Height
oShape.setSize( oSize )
Erase oSize
End Sub
WFm-)[Writer]Design mode ON/OFF(1)
Sub oFormDesignMode()
Dim oDoc as Object
Dim oCtrl as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
'
if oCtrl.isFormDesignMode = false then
oCtrl.setFormDesignMode(true)
msgbox("Design Mode / ON",0,"Design Mode")
else
msgobx("既にDesign Modeです。",0,"Design Mode")
end if
'
oCtrl.setFormDesignMode(false)
msgbox("Design Mode / OFF",0,"Design Mode")
End Sub
'
' Messagebox の下のTool Barが変更している事で分る。
WFm-)[Writer]Design mode ON/OFF(2)
Sub oFormDesignMode()
Dim oDoc as Object
Dim oCtrl as Object
Dim oFrame as Object
Dim dispatcher as Object
Dim args1(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
if oCtrl.isFormDesignMode = false then
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = true
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
msgbox("Design Mode / ON( 2 )",0,"Design Mode")
else
msgobx("既にDesign Modeです。",0,"Design Mode")
end if
'
args1(0).Name = "SwitchControlDesignMode"
args1(0).Value = false
dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
msgbox("Design Mode / OFF( 2 )",0,"Design Mode")
End Sub
WFm-)[Writer]
Draw[Writer]
WDw-)[Writer]Line
Sub oDrawInWriter
Dim oDoc
Dim oDrawPage
Dim oShape
Dim oDummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter","_default", 0, oDummy)
oDrawPage = oDoc.getDrawPage()
' Drawing Start
Dim oSize as new com.sun.star.awt.Size
Dim oStepSize as Double
oStepSize = 800
for i = 0 to 10
oShape = oDoc.createInstance("com.sun.star.drawing.LineShape")
oShape.LineColor = RGB(255, 255-20*i, 20*i)
oShape.LineWidth = 50
oSize.Width = CLng(oStepSize /5 * i -oStepSize )
oSize.Height = oStepSize
oShape.setSize(oSize)
oDrawPage.add(oShape)
next i
End Sub
DateTime[Writer]
WDaTm-)[Writer]現地時間入力
Sub oWriterFont
Dim oDoc As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oVCurs = oDoc.CurrentController.getViewCursor()
oTCurs = oText.createTextCursorByRange(oVCurs.getStart())
oDisp = "What time is it now?" & Chr(10) & "It is "
oText.insertString(oTCurs, oDisp, FALSE)
'
oFormats = oDoc.getNumberFormats()
'
Dim oLanguage As New com.sun.star.lang.Locale
oLanguage.Country = "ja"
oLanguage.Language = "JP"
oFormatNum = oFormats.queryKey ( "hh:mm:ss", oLanguage, TRUE)
'
oDateTime = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
oDateTime.IsFixed = TRUE
'
oText.insertTextContent(oTCurs,oDateTime,FALSE)
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
Annotation
WDw-)[Writer]注記の挿入
Sub WriterAddNoteAtCursor()
Dim oDoc
Dim oViewCursor
Dim oCurs
Dim oTextField
Dim oDate As New com.sun.star.util.Date
Dim Dummy()
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
'
Dim oText as Object
Dim oSText as String
oText = oDoc.getText()
oSText = "Annotation(注記)"
oText.insertString(oText.getStart(), oSText , false) '文頭
'
With oDate
.Day = Day(Now - 10)
.Month = Month(Now - 10)
.Year = Year(Now - 10)
End With
'
oViewCursor = oDoc.getCurrentController().getViewCursor()
oCurs=oText.createTextCursorByRange(oViewCursor.getStart())
'
oTextField = oDoc.createInstance("com.sun.star.text.TextField.Annotation")
With oTextField
.Author = "AP"
.Content = "It sure is fun to insert notes into my document"
.Date = oDate
End With
'
oText.insertTextContent(oCurs, oTextField, False)
End Sub
View
WDw-)[Writer]印刷レイアウトON/OFF
Sub WriterView()
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 = "PrintLayout"
oProp(0).Value = False
oDispatcher.executeDispatch( oFrame, ".uno:PrintLayout", "", 0, oProp())
msgbox "印刷レイアウト ON" & Chr$(10) & "(DispatchHelper)",0,"View"
'
oProp(0).Name = "PrintLayout"
oProp(0).Value = True
oDispatcher.executeDispatch( oFrame, ".uno:PrintLayout", "", 0, oProp())
msgbox "印刷レイアウト OFF" & Chr$(10) & "( Webレイアウト ON )" & Chr$(10) & "(DispatchHelper)",0,"View"
End Sub
WDw-)[Writer]WebレイアウトON/OFF
Sub WriterView()
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 = "BrowseView"
oProp(0).Value = False
oDispatcher.executeDispatch( oFrame, ".uno:BrowseView", "", 0, oProp())
msgbox "Webレイアウト ON" & Chr$(10) & "(DispatchHelper",0,"View / LO4.2.4"
'
oProp(0).Name = "BrowseView"
oProp(0).Value = True
oDispatcher.executeDispatch( oFrame, ".uno:BrowseView", "", 0, oProp())
msgbox "Webレイアウト OFF" & Chr$(10) & "( 印刷レイアウト ON )" & Chr$(10) & "(DispatchHelper)",0,"View / LO4.2.4"
End Sub
WDw-)[Writer]横/縦Ruler ON/OFF(1)
Sub WriterView()
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 = "Ruler"
oProp(0).Value = False
oDispatcher.executeDispatch( oFrame, ".uno:Ruler", "", 0, oProp())
msgbox "Ruler OFF" & Chr$(10) & "(DispatchHelper",0,"View / LO4.2.4"
'
oProp(0).Name = "Ruler"
oProp(0).Value = True
oDispatcher.executeDispatch( oFrame, ".uno:Ruler", "", 0, oProp())
msgbox "Ruler ON" & Chr$(10) & "(DispatchHelper)",0,"View / LO4.2.4"
End Sub
WDw-)[Writer]横/縦Ruler ON/OFF(2)
Sub WriterView()
Dim oDoc as Object, oCtrl as Object, oViewSet as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oViewSet = oCtrl.getViewSettings()
'
oViewSet.ShowRulers = False
msgbox "縦/横Ruler OFF",0,"View / LO4.2.4"
'
oViewSet.ShowRulers = True
msgbox "縦/横Ruler ON",0,"View / LO4.2.4"
End Sub
WDw-)[Writer]横Ruler ON/OFF
Sub WriterView()
Dim oDoc as Object, oCtrl as Object, oViewSet as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oViewSet = oCtrl.getViewSettings()
'
oViewSet.ShowHoriRuler = False
msgbox "横Ruler OFF",0,"View / LO4.2.4"
'
oViewSet.ShowHoriRuler = True
msgbox "横Ruler ON",0,"View / LO4.2.4"
End Sub
WDw-)[Writer]縦Ruler ON/OFF
Sub WriterView()
Dim oDoc as Object, oCtrl as Object, oViewSet as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oViewSet = oCtrl.getViewSettings()
'
oViewSet.ShowVertRuler = False
msgbox "縦Ruler OFF",0,"View / LO4.2.4"
'
oViewSet.ShowVertRuler = True
msgbox "縦Ruler ON",0,"View / LO4.2.4"
End Sub
WDw-)[Writer]縦Rulerの右側表示ON/OFF
Sub WriterView()
Dim oDoc as Object, oCtrl as Object, oViewSet as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oViewSet = oCtrl.getViewSettings()
'
oViewSet.IsVertRulerRightAligned = True
msgbox "縦Rulerの右表示ON",0,"View / LO4.2.4"
'
oViewSet.IsVertRulerRightAligned = False
msgbox "縦Rulerの右表示OFF" & Chr$(10) & "(縦Rulerの左表示)",0,"View / LO4.2.4"
End Sub
WDw-)[Writer]数式Bar表示
Sub WriterView()
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:InsertFormula", "", 0, Array())
msgbox "数式Bar 表示" & Chr$(10) & "(DispatchHelper",0,"View / LO4.2.4"
End Sub
'
' [ Note ]
' 数式Barの非表示は上記では出来ない。
WDw-)[Writer]Field Name表示 ON/OFF
Sub WriterField()
Dim oDoc As Object, oText as Object
Dim oVCurs as Object, oTCurs as Object
Dim oDateTime as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oText = oDoc.getText()
oVCurs = oDoc.CurrentController.getViewCursor()
oTCurs = oText.createTextCursorByRange(oVCurs.getStart())
oDisp = "What time is it now?" & Chr(10) & "It is "
oText.insertString(oTCurs, oDisp, FALSE)
'
oFormats = oDoc.getNumberFormats()
'
Dim oLanguage As New com.sun.star.lang.Locale
oLanguage.Country = "ja"
oLanguage.Language = "JP"
oFormatNum = oFormats.queryKey ( "hh:mm:ss", oLanguage, TRUE)
'
oDateTime = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
oDateTime.IsFixed = TRUE
oText.insertTextContent(oTCurs,oDateTime,FALSE)
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' Field 名の表示/非表示
msgbox "Fieldnames表示前",0,"Field / LO4.2.4"
oProp(0).Name = "Fieldnames"
oProp(0).Value = True
oDispatcher.executeDispatch( oFrame, ".uno:Fieldnames", "", 0, oProp())
msgbox "Fieldnames ON" & Chr$(10) & "(DispatchHelper",0,"Field / LO4.2.4"
'
oProp(0).Name = "Fieldnames"
oProp(0).Value = False
oDispatcher.executeDispatch( oFrame, ".uno:Fieldnames", "", 0, oProp())
msgbox "Fieldnames OFF" & Chr$(10) & "(DispatchHelper",0,"Field / LO4.2.4"
End Sub
WDw-)[Writer]Annotation表示 ON/OFF(1)
Sub WriterAnnotationView()
Dim oDoc as Object, oText as Object
Dim oViewCursor as Object, oCurs as Object, oTextField as Object
Dim oSText as String, oDisp as String
Dim oDate As New com.sun.star.util.Date
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oText = oDoc.getText()
oSText = Chr$(9) &Chr$(9) &Chr$(9) &Chr$(9) & Chr$(9) & _
Chr$(9) & Chr$(9) & Chr$(9) & "LibreOffice4.2.4のAnnotation(注記)"
oText.insertString(oText.getStart(), oSText , false) '文頭
With oDate
.Day = Day(Now - 10)
.Month = Month(Now - 10)
.Year = Year(Now - 10)
End With
oViewCursor = oDoc.getCurrentController().getViewCursor()
oCurs=oText.createTextCursorByRange(oViewCursor.getStart())
oTextField = oDoc.createInstance("com.sun.star.text.TextField.Annotation")
With oTextField
.Author = "AP"
.Content = "It sure is fun to insert notes into my document"
.Date = oDate
End With
oText.insertTextContent(oCurs, oTextField, False)
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' Annotation の表示/非表示
msgbox "Annotation",0,"Annotation / LO4.2.4"
oProp(0).Name = "ShowAnnotations"
oProp(0).Value = False
oDispatcher.executeDispatch( oFrame, ".uno:ShowAnnotations", "", 0, oProp())
msgbox "Annotation OFF" & Chr$(10) & "(DispatchHelper",0,"Annotation / LO4.2.4"
'
oProp(0).Name = "ShowAnnotations"
oProp(0).Value = True
oDispatcher.executeDispatch( oFrame, ".uno:ShowAnnotations", "", 0, oProp())
msgbox "Annotation ON" & Chr$(10) & "(DispatchHelper",0,"Annotation / LO4.2.4"
End Sub
WDw-)[Writer]Annotation表示 ON/OFF(2)
Sub WriterAnnotationView()
Dim oDoc as Object, oText as Object
Dim oViewCursor as Object, oCurs as Object, oTextField as Object
Dim oSText as String, oDisp as String
Dim oDate As New com.sun.star.util.Date
Dim oCtrl as Object, oViewSet as Object
oDoc = ThisComponent
oText = oDoc.getText()
oSText = Chr$(9) &Chr$(9) &Chr$(9) &Chr$(9) & Chr$(9) & _
Chr$(9) & Chr$(9) & Chr$(9) & Chr$(9) & Chr$(9) & _
Chr$(9) & "LO4.2.4の注記"
oText.insertString(oText.getStart(), oSText , false) '文頭
With oDate
.Day = Day(Now - 10)
.Month = Month(Now - 10)
.Year = Year(Now - 10)
End With
oViewCursor = oDoc.getCurrentController().getViewCursor()
oCurs=oText.createTextCursorByRange(oViewCursor.getStart())
oTextField = oDoc.createInstance("com.sun.star.text.TextField.Annotation")
With oTextField
.Author = "AP"
.Content = "It sure is fun to insert notes into my document"
.Date = oDate
End With
oText.insertTextContent(oCurs, oTextField, False)
'
oCtrl = oDoc.getCurrentController()
oViewSet = oCtrl.getViewSettings()
' Annotation の表示/非表示
msgbox "Annotation",0,"Annotation / LO4.2.4"
'
oViewSet.ShowAnnotations = False
msgbox "Annotation OFF",0,"Annotation / LO4.2.4"
'
oViewSet.ShowAnnotations = True
msgbox "Annotation ON", 0,"Annotation / LO4.2.4"
End Sub
WDw-)[Writer]編集記号の表示 ON/OFF
Sub WriterView()
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 = "ControlCodes"
oProp(0).Value = True
oDispatcher.executeDispatch( oFrame, ".uno:ControlCodes", "", 0, oProp())
msgbox "編集記号 ON" & Chr$(10) & "(DispatchHelper",0,"View / LO4.2.4"
'
oProp(0).Name = "ControlCodes"
oProp(0).Value = False
oDispatcher.executeDispatch( oFrame, ".uno:ControlCodes", "", 0, oProp())
msgbox "編集記号 OFF" & Chr$(10) & "(DispatchHelper)",0,"View / LO4.2.4"
End Sub
WDw-)[Writer]横Scroll Bar表示/非表示
Sub WriterView()
Dim oDoc as Object, oCtrl as Object, oViewSet as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oViewSet = oCtrl.getViewSettings()
'
oViewSet.ShowHoriScrollBar = False
msgbox "横Scroll Bar非表示",0,"View / LO4.2.4"
'
oViewSet.ShowHoriScrollBar = True
msgbox "横Scroll Bar表示",0,"View / LO4.2.4"
End Sub
WDw-)[Writer]縦Scroll Bar表示/非表示
Sub WriterView()
Dim oDoc as Object, oCtrl as Object, oViewSet as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oViewSet = oCtrl.getViewSettings()
'
oViewSet.ShowVertScrollBar = False
msgbox "縦Scroll Bar非表示",0,"View / LO4.2.4"
'
oViewSet.ShowVertScrollBar = True
msgbox "縦Scroll Bar表示",0,"View / LO4.2.4"
End Sub
WDw-)[Writer]
