File
[ Open / Close ]
[ File Property ]
Document
[ Font ]
[ Text ]
[ Selected Text ]
[ Cursor ]
[ Count ]
Page
[ Header / Footer ]
Paragraph Property
File
[ Open / Close ]
Sub oWriterOpen
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oAns = Msgbox("ファイルを閉じますか?",4, "File Close確認")
if oAns = 6 then
oDoc.dispose
End if
End Sub
Sub oWriterOpen_Save
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy())
oAns = Msgbox("fileを保存しますか?",4, "File Save確認")
if oAns = 6 then
oInp = InputBox("Full pathでFile nameを入力して下さい(例 ： C:\temp\btest.odt)","保存File nameの入力")
If NOT IsNull(oInp) then
oWName = ConvertToUrl(oInp)
oDoc.storeAsURL(oWName, Dummy())
End If
End If
oAnsC = MsgBox("Fileを閉じますか?",4,"Fileの終了確認")
If oAnsC = 6 then
oDoc.dispose
End If
End Sub
Sub oWriter_HTML_Web_Doc
dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter/web", "_blank", 0, Dummy())
End Sub
Sub oGlobalDoc
dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter/GlobalDocument", "_blank", 0, Dummy())
End Sub[ File Property ]
Sub oPropInfo
Dim oDoc
Dim oDummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, oDummy())
oprop = oDoc.IndexAutoMarkFileURL
msgbox(oprop,0,"[ IndexAutoMarkFileURL ]")
oDoc.dispose
Exit Sub
oBad:
mErr = Error
eline = Erl
msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
oDoc.dispose
End SUb
Sub oPropInfo
Dim oDoc
Dim oDummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, oDummy())
oprop = oDoc.WordSeparator
msgbox(oprop,0,"[ WordSeparator ]")
oDoc.dispose
Exit Sub
oBad:
mErr = Error
eline = Erl
msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
oDoc.dispose
End SUb
Document
[ Font ]
Sub DocFont()
Dim oDoc As Object, oText As Object, oTextCursor as Object
oDoc = ThisComponent
oText = oDoc.getText()
oText.String="水素はH2"
oTextCursor = oText.createTextCursor()
With oTextCursor
.gotoEnd( False )
.goLeft(1, true) '←1文字
.setPropertyValue( "CharEscapement",101 ) '←上付きは101
.setPropertyValue( "CharEscapementHeight", 60 ) '←60%
.gotoEnd( False )
End With
msgbox "Success"
End Sub
Sub DocFont()
Dim oDoc As Object, oText As Object, oTextCursor as Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oText.String="水素はH2"
oTextCursor = oText.createTextCursor()
With oTextCursor
.gotoStart( False )
.gotoEnd( False )
.goLeft(1,true) 'LeftはgotoStart、gotoEndの後に記す。
.setPropertyValue( "CharEscapement",-101 ) '←下付きは-101
.setPropertyValue( "CharEscapementHeight", 60 ) '←60%
End With
msgbox "Success"
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=80
.CharHeightAsian=40
End With
oText.String="ABCDEFGこれはテストです" 'Writerは先に書式設定する必要有
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
Sub oWriterFont
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharHeight = 20
.CharHeightAsian = 20
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharFontPitch = com.sun.star.awt.FontPitch.FIXED ' FIXED と VARIABLEとも結果は同じ?
.CharFontPitch = com.sun.star.awt.FontPitch.VARIABLE
.CharPosture = com.sun.star.awt.FontSlant.ITALIC
.CharPostureAsian = com.sun.star.awt.FontSlant.ITALIC
End With
oText.String="ABCDEFG1234これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian=40
.CharFontPitch = com.sun.star.awt.FontPitch.FIXED ' FIXED と VARIABLEとも結果は同じ?
.CharFontPitch = com.sun.star.awt.FontPitch.VARIABLE
.CharPosture = com.sun.star.awt.FontSlant.OBLIQUE
.CharPostureAsian = com.sun.star.awt.FontSlant.OBLIQUE
End With
oText.String="ABCDEFG1234これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharPosture = com.sun.star.awt.FontSlant.REVERSE_ITALIC
.CharPostureAsian = com.sun.star.awt.FontSlant.REVERSE_ITALIC
End With
oText.String="ABCDEFG1234これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian=40
.CharPosture = com.sun.star.awt.FontSlant.REVERSE_OBLIQUE
.CharPostureAsian = com.sun.star.awt.FontSlant.REVERSE_OBLIQUE
End With
oText.String="ABCDEFG1234これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharWeight = com.sun.star.awt.FontWeight.BOLD
.CharWeightAsian = com.sun.star.awt.FontWeight.BOLD
'.CharPosture = com.sun.star.awt.FontSlant.REVERSE_OBLIQUE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharWeight = com.sun.star.awt.FontWeight.SEMIBOLD
.CharWeightAsian = com.sun.star.awt.FontWeight.SEMIBOLD
'.CharPosture = com.sun.star.awt.FontSlant.REVERSE_OBLIQUE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharWeight = com.sun.star.awt.FontWeight.ULTRABOLD
.CharWeightAsian = com.sun.star.awt.FontWeight.ULTRABOLD
'.CharPosture = com.sun.star.awt.FontSlant.REVERSE_OBLIQUE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharWeight = com.sun.star.awt.FontWeight.BLACK
.CharWeightAsian = com.sun.star.awt.FontWeight.BLACK
'.CharPosture = com.sun.star.awt.FontSlant.REVERSE_OBLIQUE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharWeight = com.sun.star.awt.FontWeight.THIN
.CharWeightAsian = com.sun.star.awt.FontWeight.THIN
'.CharPosture = com.sun.star.awt.FontSlant.REVERSE_OBLIQUE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharWeight = com.sun.star.awt.FontWeight.ULTRALIGHT
.CharWeightAsian = com.sun.star.awt.FontWeight.ULTRALIGHT
'.CharPosture = com.sun.star.awt.FontSlant.REVERSE_OBLIQUE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharWeight = com.sun.star.awt.FontWeight.LIGHT
.CharWeightAsian = com.sun.star.awt.FontWeight.LIGHT
'.CharPosture = com.sun.star.awt.FontSlant.REVERSE_OBLIQUE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharWeight = com.sun.star.awt.FontWeight.SEMILIGHT
.CharWeightAsian = com.sun.star.awt.FontWeight.SEMILIGHT
'.CharPosture = com.sun.star.awt.FontSlant.REVERSE_OBLIQUE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.SINGLE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.DOUBLE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.DOTTED
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.DASH
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.LONGDASH
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.DASHDOT
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.DASHDOTDOT
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.SMALLWAVE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.WAVE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.DOUBLEWAVE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.BOLD
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.BOLDDOTTED
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.BOLDDASH
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.BOLDLONGDASH
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.BOLDDASHDOT
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.BOLDDASHDOTDOT
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=40
.CharHeightAsian=40
.CharUnderline = com.sun.star.awt.FontUnderline.BOLDWAVE
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 20
.CharHeightAsian = 20
.CharUnderline = com.sun.star.awt.FontUnderline.DOUBLE
.CharUnderlineColor = 2918503 ' Color of the Underline of Font
.CharUnderlineHasColor = true
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub GnlFont()
Dim oDoc As Object, oText As Object, oCur as Object
Dim oCtrl as Object, oFrame as Object
Dim Dummy()
Dim oDispatcher as Object
Dim oProp(2) as new com.sun.star.beans.PropertyValue
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oCur = oText.createTextCursor
'
oCur.gotoStart(false)
oCur.setString("LibreOffice と Apache OpenOfficeです。")
'
' Docment文字を選択する
oCtrl = oDoc.getCurrentController()
oCtrl.select(oText)
'
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' 下線
oProp(0).Name = "Underline.LineStyle"
oProp(0).Value = com.sun.star.awt.FontUnderline.SINGLE ' = 1
oProp(1).Name = "Underline.HasColor"
oProp(1).Value = true
oProp(2).Name = "Underline.Color"
oProp(2).Value = &HFF0000 ' Red
oDispatcher.executeDispatch(oFrame, ".uno:Underline", "", 0, oProp())
End Sub
Sub GnlFont()
Dim oDoc As Object, oText As Object, oCur as Object
Dim oCtrl as Object, oFrame as Object
Dim Dummy()
Dim oDispatcher as Object
Dim oProp(2) as new com.sun.star.beans.PropertyValue
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oCur = oText.createTextCursor
'
oCur.gotoStart(false)
oCur.setString("LibreOffice と Apache OpenOfficeです。")
'
' Docment文字を選択する
oCtrl = oDoc.getCurrentController()
oCtrl.select(oText)
'
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' 下線
oProp(0).Name = "Overline.LineStyle"
oProp(0).Value = 15
oProp(1).Name = "Overline.HasColor"
oProp(1).Value = true
oProp(2).Name = "Overline.Color"
oProp(2).Value = &HFF0000 ' Red
oDispatcher.executeDispatch(oFrame, ".uno:Overline", "", 0, oProp())
End Sub
'
' [ Note ]
' 0 : NONE
' 1 : SINGLE
' 2 : DOUBLE
' 3 : DOTTED
' 4 : DONTKNOW
' 5 : DASH
' 6 : LONGDASH
' 7 : DASHDOT
' 8 : DASHDOTDOT
' 9 : SMALLWAVE
' 10 : WAVE
' 11 : DOUBLEWAVE
' 12 : BOLD
' 13 : BOLDDOTTED
' 14 : BOLDDASH
' 15 : BOLDLONGDASH
' 16 : BOLDDASHDOT
' 17 : BOLDDASHDOTDOT
' 18 : BOLDWAVE
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharHeight = 20
.CharHeightAsian = 20
.CharWeight = com.sun.star.awt.FontWeight.ULTRABOLD
.CharWeightAsian = com.sun.star.awt.FontWeight.ULTRABOLD
.CharShadowed = false
End With
oText.String="AbcDe12345これはテストです"
'
oDisp = Chr$(13)
oText.insertString(oText.getEnd(), oDisp, false)
'
with oTextCursor
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharHeight = 20
.CharHeightAsian = 20
.CharWeight = com.sun.star.awt.FontWeight.ULTRABOLD
.CharWeightAsian = com.sun.star.awt.FontWeight.ULTRABOLD
.CharShadowed = true
End With
oDisp = "AbcDe12345これはテストです"
oText.insertString(oText.getEnd(), oDisp, false)
End Sub
Sub GnlFont()
Dim oDoc As Object, oText As Object, oCur as Object
Dim oCtrl as Object, oFrame as Object
Dim Dummy()
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oCur = oText.createTextCursor
'
oCur.gotoStart(false)
oCur.setString("LibreOffice と Apache OpenOfficeです。")
'
' Docment文字を選択する
oCtrl = oDoc.getCurrentController()
oCtrl.select(oText)
'
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' 影付き文字
oProp(0).Name = "Shadowed"
oProp(0).Value = true
oDispatcher.executeDispatch(oFrame, ".uno:Shadowed", "", 0, oProp())
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharStrikeout = com.sun.star.awt.FontStrikeout.SINGLE
' .CharStrikeout = 1 ' Font is striked out with double line
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharStrikeout = com.sun.star.awt.FontStrikeout.DOUBLE
' .CharStrikeout = 2 ' Font is striked out with double line
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharStrikeout = com.sun.star.awt.FontStrikeout.BOLD
' .CharStrikeout = 4 ' Font is striked out with double line
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharStrikeout = com.sun.star.awt.FontStrikeout.SLASH
' .CharStrikeout = 5 ' Font is striked out with double line
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 40
.CharHeightAsian = 40
.CharStrikeout = com.sun.star.awt.FontStrikeout.X
' .CharStrikeout = 6 ' Font is striked out with double line
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharHeight = 40
.CharHeightAsian = 40
.CharCrossedOut = true
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
End Sub
Sub GnlFont()
Dim oDoc As Object, oText As Object, oCur as Object
Dim oCtrl as Object, oFrame as Object
Dim Dummy()
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oCur = oText.createTextCursor
'
oCur.gotoStart(false)
oCur.setString("LibreOffice と Apache OpenOfficeです。")
'
' Docment文字を選択する
oCtrl = oDoc.getCurrentController()
oCtrl.select(oText)
'
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' 下線
oProp(0).Name = "Strikeout.Kind"
oProp(0).Value = com.sun.star.awt.FontStrikeout.SLASH
oDispatcher.executeDispatch(oFrame, ".uno:Strikeout", "", 0, oProp())
End Sub
'
' [ Note ]
' com.sun.star.awt.FontStrikeout.NONE : 0
' com.sun.star.awt.FontStrikeout.SINGLE : 1
' com.sun.star.awt.FontStrikeout.DOUBLE : 2
' com.sun.star.awt.FontStrikeout.DONTKNOW : 3
' com.sun.star.awt.FontStrikeout.BOLD : 4
' com.sun.star.awt.FontStrikeout.SLASH : 5
' com.sun.star.awt.FontStrikeout.X : 6
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharHeight = 40
.CharHeightAsian = 40
.CharCasemap = com.sun.star.style.CaseMap.UPPERCASE
' .CharCasemap = 1 ' <= こちらでもOK 値はShort
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharHeight = 40
.CharHeightAsian = 40
.CharCasemap = com.sun.star.style.CaseMap.LOWERCASE
' .CharCasemap = 2 ' <= こちらでもOK 値はShort
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharHeight = 40
.CharHeightAsian = 40
.CharCasemap = com.sun.star.style.CaseMap.TITLE
' .CharCasemap = 3 ' <= こちらでもOK 値はShort
End With
oText.String="AbcDe12345これはテストです" Rem Writerは先に書式設定する必要有
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharHeight = 40
.CharHeightAsian = 40
.CharCasemap = com.sun.star.style.CaseMap.SMALLCAPS
' .CharCasemap = 4 ' <= こちらでもOK 値はShort
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharHeight = 40
.CharHeightAsian = 40
.CharFlash = true
End With
oText.String="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharHeight = 40
.CharHeightAsian = 40
.CharStrikeout = 2
.CharUnderline = 1
.CharWordMode = true
End With
oText.String="Ab cDe 12345" & Chr$(9) & "これはテストです" 'Writerは先に書式設定する必要有
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 20
.CharHeightAsian = 20
.CharContoured = true
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub GnlFont()
Dim oDoc As Object, oText As Object, oCur as Object
Dim oCtrl as Object, oFrame as Object
Dim Dummy()
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oCur = oText.createTextCursor
'
oCur.gotoStart(false)
oCur.setString("LibreOffice と Apache OpenOfficeです。")
'
' Docment文字を選択する
oCtrl = oDoc.getCurrentController()
oCtrl.select(oText)
'
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' Outline Font( 中抜き文字 )
oProp(0).Name = "OutlineFont"
oProp(0).Value = true
oDispatcher.executeDispatch(oFrame, ".uno:OutlineFont", "", 0, oProp())
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 20
.CharHeightAsian = 20
.CharEmphasis = com.sun.star.text.FontEmphasis.DOT_ABOVE
' .CharEmphasis = 1 ' <= Short型での設定値
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 20
.CharHeightAsian = 20
.CharEmphasis = com.sun.star.text.FontEmphasis.CIRCLE_ABOVE
' .CharEmphasis = 2 ' <= Short型での設定値
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 20
.CharHeightAsian = 20
.CharEmphasis = com.sun.star.text.FontEmphasis.DISK_ABOVE
' .CharEmphasis = 3 ' <= Short型での設定値
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 20
.CharHeightAsian = 20
.CharEmphasis = com.sun.star.text.FontEmphasis.ACCENT_ABOVE
' .CharEmphasis = 4 ' <= Short型での設定値
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 20
.CharHeightAsian = 20
.CharEmphasis = com.sun.star.text.FontEmphasis.DOT_BELOW
' .CharEmphasis = 11 ' <= Short型での設定値
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 20
.CharHeightAsian = 20
.CharEmphasis = com.sun.star.text.FontEmphasis.CIRCLE_BELOW
' .CharEmphasis = 12 ' <= Short型での設定値
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 20
.CharHeightAsian = 20
.CharEmphasis = com.sun.star.text.FontEmphasis.DISK_BELOW
' .CharEmphasis = 13 ' <= Short型での設定値
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 20
.CharHeightAsian = 20
.CharEmphasis = com.sun.star.text.FontEmphasis.ACCENT_BELOW
' .CharEmphasis = 14 ' <= Short型での設定値
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 20
.CharHeightAsian = 20
.CharRelief = com.sun.star.text.FontRelief.EMBOSSED
' .CharRelief = 1 ' <= Short型での設定値
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub WriterFont()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight = 20
.CharHeightAsian = 20
.CharRelief = com.sun.star.text.FontRelief.ENGRAVED
' .CharRelief = 2 ' <= Short型での設定値
End With
oText.String="AbcDe12345これはテストです"
End Sub
Sub GnlFont()
Dim oDoc As Object, oText As Object, oCur as Object
Dim oCtrl as Object, oFrame as Object
Dim Dummy()
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oCur = oText.createTextCursor
'
oCur.gotoStart(false)
oCur.setString("LibreOffice と Apache OpenOfficeです。")
'
' Docment文字を選択する
oCtrl = oDoc.getCurrentController()
oCtrl.select(oText)
'
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' 浮き出し
oProp(0).Name = "CharacterRelief"
oProp(0).Value = 1
oDispatcher.executeDispatch(oFrame, ".uno:CharacterRelief", "", 0, oProp())
msgbox "浮き出し文字",0,"CharacterRelief"
' 浮き彫り
oProp(0).Name = "CharacterRelief"
oProp(0).Value = 2
oDispatcher.executeDispatch(oFrame, ".uno:CharacterRelief", "", 0, oProp())
msgbox "浮き彫り文字",0,"CharacterRelief"
End Sub
Sub WriterCharAutoKerning()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=20
.CharAutoKerning = true
End With
oKerTrue = "A b cDe fGh ijkLmnopq12 34 5(CharAutoKerning: True)" & Chr$(13)
oText.insertString(oText.getEnd(), oKerTrue, false) '文末="AbcDe12345これはテストです" 'Writerは先に書式設定する必要有
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
Sub WriterCharAutoKerning()
Dim oDoc As Object
Dim oText As Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=20
.CharBackColor = 2345667 ' Backgroundcolor of Font
End With
oCharText = "A b cDe fGh ijkLmnopq12 34 5"
oText.insertString(oText.getEnd(), oCharText, 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
Sub WriterChar()
Dim oDoc as Object
Dim oText as Object
Dim oTextCursor as Object
Dim oCharText as String
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_default", 0, Dummy())
oText = oDoc.getText()
oTextCursor = oText.createTextCursor()
with oTextCursor
.CharHeight=20
.CharBackColor = 2345667 ' <= 背景をsetしても CharBackTransparent = true で透明にされる。
.CharBackTransparent = true
End With
oCharText = "A b cDe fGh ijkLmnopq12 34 5"
oText.insertString(oText.getStart(), oCharText, false)
End Sub
Sub FontPropInfo()
Dim oDoc
Dim oDummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, oDummy())
oprop1 = oDoc.CharFontStyleNameAsian
oprop2 = oDoc.CharFontStyleName
oprop3 = oDoc.CharFontStyleNameComplex
msgbox(" CharFontStyleNameAsian => " & oprop1 & Chr$(10) & _
" CharFontStyleName => " & oprop2 & Chr$(10) & _
" CharFontStyleNameComplex => " & oprop3 ,0,"[ CharFontStyleName ]")
oDoc.dispose
Exit Sub
oBad:
mErr = Error
eline = Erl
msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
oDoc.dispose
End SUb
Sub FontPropInfo()
Dim oDoc
Dim oDummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, oDummy())
oprop1 = oDoc.CharFontNameAsian
oprop2 = oDoc.CharFontName
msgbox(" CharFontNameAsian => " & oprop1 & Chr$(10) & _
" CharFontName => " & oprop2 ,0,"[ CharFontName ]")
oDoc.dispose
Exit Sub
oBad:
mErr = Error
eline = Erl
msgbox("Line : " & eline & Chr$(10) & mErr & Chr$(10) &" : i = " & i, 0,"Error Message" )
oDoc.dispose
End SUb
Sub DocCharFontNameComplex()
Dim oDoc
Dim OOo
Dim SufOOo
Dim oTempName
Dim oDummy()
Dim oArray(0) As New com.sun.star.beans.PropertyValue
Dim oProp
oProp = "CharFontNameComplex"
' Initialize Display
oDisp = "<< " & oProp & " >>" & Chr$(10) & " "
OOo = "writer"
SufOOo = "odt"
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter" , "_blank", 0, oDummy())
oTempName = ConvertToUrl("c:\temp\oDocProp." & SufOOo)
oArray(0).Name = "Overwrite"
oArray(0).Value = true
oDoc.storeAsURL(oTempName,oArray())
'Properties [ String ]
oS= oDoc.CharFontNameComplex
If NOT IsEmpty(oS) and NOT IsNull(oS) and oS<>"" then
oDisp = oDisp & "[ " & OOo & " ] = "& oS & Chr$(10) & " "
End If
oDoc.close(true)
If n > 5 then Exit Sub
If oDisp = "<< " & oProp & " >>" & Chr$(10) & " " then
oDisp = oDisp & Chr$(10) & " に関する情報はありません"
End If
msgbox(oDisp, 0, oProp & " of PropertiesString" )
End Sub
[ Text ]
Sub Main
Dim oText as Object
oText = ThisComponent.getText()
oSText = "[ Text Start ] " & Chr$(13)
oEText = Chr$(13) & "[ Text End ] "
oText.insertString(oText.getStart(), oSText , false) '文頭
oText.insertString(oText.getEnd(), oEText, false) '文末
End Sub
Sub oCursorGotoinWriter
Dim oDoc
Dim oText
Dim oCur
oDoc = ThisComponent
oText = oDoc.getText()
oCur = oText.createTextCursor
'
oCur.gotoStart(false)
oCur.setString("「Documentの最初に追加した文です。」"
End Sub
Sub oCursorGotoinWriter
Dim oDoc
Dim oText
Dim oCur
oDoc = ThisComponent
oText = oDoc.getText()
oCur = oText.createTextCursor
'
oCur.gotoEnd(false)
oCur.setString("「Documentの最初に追加した文です。」"
End Sub
Sub oCursorGotoinWriter
Dim oDoc
Dim oText
Dim oCur
oDoc = ThisComponent
oText = oDoc.getText()
oCur = oText.createTextCursor
'
oCur.gotoStartOfParagraph(false)
oCur.setString("「Macroにて追加した文です。」"
End Sub
Sub oCursorGotoinWriter
Dim oDoc
Dim oText
Dim oCur
oDoc = ThisComponent
oText = oDoc.getText()
oCur = oText.createTextCursor
'
oCur.gotoEndOfParagraph(false)
oCur.setString("「Macroにて追加した文です。」"
End Sub
Sub oCursorGotoinWriter
Dim oDoc
Dim oText
Dim oCur
oDoc = ThisComponent
oText = oDoc.getText()
oCur = oText.createTextCursor
'
oCur.gotoNextParagraph(false)
oCur.setString("「Macroにて追加した文です。」"
End Sub
Sub oCursorGotoinWriter
Dim oDoc
Dim oText
Dim oCur
oDoc = ThisComponent
oText = oDoc.getText()
oCur = oText.createTextCursor
'
oCur.goto(false)
oCur.setString("「Paragraph2に追加した文です。」"
'
oCur.gotoNextParagraph(false)
oCur.setString("「Paragraph2の前のParagraphに追加した文です。」"
End Sub
Sub oParagraph
Dim oDoc
Dim oText
Dim oEnum ' com.sun.star.container.XEnumerationAccess
Dim oPar
Dim oNumPar
Dim Dummy()
Dim oCur
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oDisp = "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$(13) & _
"This line is fourth paragraph. It is fifth line."
oText.insertString(oText.getEnd(), oDisp, false)
'Count Paragrah
oEnum = oDoc.Text.createEnumeration()
Do While oEnum.hasMoreElements()
oPar = oEnum.nextElement()
If oPar.SupportsService("com.sun.star.text.Paragraph") then
oNumPar = oNumPar + 1
End If
Loop
print oNumPar
'3th Paragraphの後にtext追加
n = 3
oCur = oText.createTextCursor
oCur.gotoStart(false)
If n <= oNumPar-1 then
for i = 0 to n
oCur.gotoNextParagraph(false)
next i
oDisp = "<<>>" & Chr$(13)
oCur.setString(oDisp)
End If
End Sub
Sub oParagraph
Dim oDoc
Dim oText
Dim oEnum ' com.sun.star.container.XEnumerationAccess
Dim oPar
Dim oNumPar
Dim Dummy()
Dim oCur
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oDisp = "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$(13) & _
"This line is fourth paragraph. It is fifth line."
oText.insertString(oText.getEnd(), oDisp, false)
'Count Paragrah
oEnum = oDoc.Text.createEnumeration()
Do While oEnum.hasMoreElements()
oPar = oEnum.nextElement()
If oPar.SupportsService("com.sun.star.text.Paragraph") then
oNumPar = oNumPar + 1
End If
Loop
print oNumPar
'文末から2+1 Paragraph目の前にtext追加
n=1
oCur = oText.createTextCursor
oCur.gotoEnd(false)
If n+2 <= oNumPar then
for i = 0 to n
oCur.gotoPreviousParagraph(false)
next i
oDisp = "<<>>" & Chr$(13)
oCur.setString(oDisp)
End If
End Sub
Sub oDocument
Dim oDoc
Dim oText
Dim oCur
Dim oNumWord
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oDisp = "This is a document for macro test in writer. This line is first paragraph. This is 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$(13) & _
"This line is fourth paragraph. It is fifth line."
oText.insertString(oText.getEnd(), oDisp, false)
'Count Sentence
oCur = oText.createTextCursor
np = 0 ' Paragraph
ns = 0 ' Sentence
nw = 2 ' Word
nc = 1 ' Charactor
oCur.gotoStart(true)
for i = 0 to np
oCur.gotoNextParagraph(false)
next i
for i = 0 to ns
oCur.gotoNextSentence(false)
next i
for i = 0 to nw
oCur.gotoNextWord(false)
next i
oCur.goRight(nc,false)
oDisp=Chr$(10) & "<>" & Chr$(10)
oCur.setString(oDisp)
End Sub
Sub WriterText()
Dim oDoc as Object, oText as Object
Dim oFirstString as String, oSecondString as String
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oFirstString = "macroのtestです。"
oText.insertString(oText.getEnd(), oFirstString, false)
'get FirstLine
oDisp = oText.getString & Chr(10) & " =>" & Chr(10)
'改Line追加
oText.insertControlCharacter(oText.getEnd(), com.sun.star.text.ControlCharacter.LINE_BREAK, False)
'Second String
oSecondString = "Second Lineです。"
oText.insertString(oText.getEnd(), oSecondString, false)
oDisp = oDisp & oText.getString
'Count Paragraph
Dim oNumPar
oNumPar = oDoc.ParagraphCount
oDisp = oDisp & Chr$(10) & Chr$(10) & "Paragraph数 : " & oNumPar
' Display
msgbox(oDisp, 0, "ControlCharacter")
End Sub
Sub WriterText()
Dim oDoc as Object, oText as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oFirstString as String, oSecondString as String
oDoc = ThisComponent
oText = oDoc.getText()
oFirstString = "macroのtestです。"
oText.insertString(oText.getEnd(), oFirstString, false)
'get FirstLine
oDisp = oText.getString & Chr(10) & " ⇒ " & Chr(10)
'改Line追加
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:InsertLinebreak", "", 0, Array())
'Second String
oSecondString = "Second Lineです。"
oText.insertString(oText.getEnd(), oSecondString, false)
oDisp = oDisp & oText.getString
'Count Paragraph
Dim oNumPar as Long
oNumPar = oDoc.ParagraphCount
oDisp = oDisp & Chr$(10) & Chr$(10) & "Paragraph数 : " & oNumPar & Chr$(10) & Chr$(10) & "( DispatchHelper )" & Chr$(10) & "[ LO4.2.4 ]"
' Display
msgbox(oDisp, 0, "ControlCharacter")
End Sub
Sub oText
Dim oDoc
Dim oText
Dim oFirstString
Dim oSecondString
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oFirstString = "macroのtestです。"
oText.insertString(oText.getEnd(), oFirstString, false)
'get FirstLine
oDisp = oText.getString & Chr(10) & " =>" & Chr(10)
'改Line追加
oText.insertControlCharacter(oText.getEnd(), com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
'Second String
oSecondString = "Second Paragraphです。"
oText.insertString(oText.getEnd(), oSecondString, false)
oDisp = oDisp & oText.getString
'Count Paragraph
Dim oNumPar
oNumPar = oDoc.ParagraphCount
oDisp = oDisp & Chr$(10) & Chr$(10) & "Paragraph数 : " & oNumPar
' Display
msgbox(oDisp, 0, "ControlCharacter")
End Sub
Sub WriterText()
Dim oDoc as Object, oText as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oFirstString as String, oSecondString as String
oDoc = ThisComponent
oText = oDoc.getText()
oFirstString = "macroのtestです。"
oText.insertString(oText.getEnd(), oFirstString, false)
'get FirstLine
oDisp = oText.getString & Chr(10) & " ⇒ " & Chr(10)
'改Paragrah追加
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:InsertPara", "", 0, Array())
'Second String
oSecondString = "Second Lineです。"
oText.insertString(oText.getEnd(), oSecondString, false)
oDisp = oDisp & oText.getString
'Count Paragraph
Dim oNumPar as Long
oNumPar = oDoc.ParagraphCount
oDisp = oDisp & Chr$(10) & Chr$(10) & "Paragraph数 : " & oNumPar & Chr$(10) & Chr$(10) & "( DispatchHelper )" & Chr$(10) & "[ LO4.2.4 ]"
' Display
msgbox(oDisp, 0, "ControlCharacter")
End Sub
Sub oWriterText
Dim oDoc As Object
Dim oText
Dim oSelections
Dim oSel
Dim oLCurs
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oString = "This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. "
oText.insertString(oText.getEnd(), oString, false)
'
' First Paragraph と Second Paragraph間に改Page挿入
oSelections = oDoc.getCurrentSelection()
'
oSel = oSelections.getByIndex(0)
oLCurs = oText.CreateTextCursorByRange(oSel)
'
oLCurs.PageDescName = oLCurs.PageStyleName ' PageDescName is the name of the new page style to use after the page break.
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
Sub WriterText()
Dim oDoc as Object, oText as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oFirstString as String, oSecondString as String
oDoc = ThisComponent
oText = oDoc.getText()
oFirstString = "This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too."
oText.insertString(oText.getEnd(), oFirstString, False)
'改Page追加
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:InsertPagebreak", "", 0, Array())
'Second String
oSecondString = "This line is second paragraph. "
oText.insertString(oText.getEnd(), oSecondString, false)
' Display
oDisp = "Success" & Chr$(10) & "( DispatchHelper )" & Chr$(10) & "[ LO4.2.4 ]"
msgbox(oDisp, 0, "ControlCharacter")
End Sub
Sub oWriterText
Dim oDoc As Object
Dim oText
Dim oSelections
Dim oSel
Dim oLCurs
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oString = "This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. "
oText.insertString(oText.getEnd(), oString, false)
'
' First Paragraph と Second Paragraph間に改Page挿入
oSelections = oDoc.getCurrentSelection()
'
oSel = oSelections.getByIndex(0)
oLCurs = oText.CreateTextCursorByRange(oSel)
' 改Page
oLCurs.PageDescName = oLCurs.PageStyleName ' PageDescName is the name of the new page style to use after the page break.
' 改Page削除
oLCurs.PageDescName = ""
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
Sub oParagraph
Dim oDoc
Dim oDText
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)
'Count Paragrah
oNumPar = oDoc.ParagraphCount
'
'Paragraph 内容取得
ReDim oNumPar
Dim oStringPar(oNumPar)
Dim oSPar(oNumPar)
oEnum = oDText.createEnumeration()
m = 0
Do While oEnum.hasMoreElements() and m < 10000
oPar = oEnum.nextElement()
If oPar.SupportsService("com.sun.star.text.Paragraph") then
oStringPar(m) = oPar.String
End If
m = m + 1
Loop
' Print
oDisp = ""
for j = 0 to m-1
oDisp = oDisp & "Paragraph " & j + 1 & " => " & oStringPar(j)
oDisp = oDisp & Chr$(10) & Chr$(10)
next j
'Display
msgbox(oDisp, 0, "各Paragraph内容取得")
End Sub
Sub EnumerateTextSections
Dim oDoc
Dim oText
Dim oParEnum 'Paragraph enumerator
Dim osecEnum 'Text section enumerator
Dim oPar 'Current paragraph
Dim oParSection 'Current section
Dim nPars As Integer 'Number of paragraphs
Dim s$
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oDisp = "Paragraph No.1の開始です。" & Chr$(10) & _
"ここもParagraph No.1です。" & Chr$(13) & _
"ここからはPragraph No.2です。" & Chr$(13) & _
"ここはParagraph No.3です。"
oText.insertString(oText.getEnd(), oDisp, false)
'
oParEnum = oText.createEnumeration()
nn = 0
Do While oParEnum.hasMoreElements() and nn < 1000
oPar = oParEnum.nextElement()
'
If oPar.supportsService("com.sun.star.text.Paragraph") Then
nPars = nPars + 1
oSecEnum = oPar.createEnumeration()
s = s & nPars & ":"
kk = 0
Do While oSecEnum.hasMoreElements() and kk < 1000
oParSection = oSecEnum.nextElement()
s = s & oParSection.TextPortionType & ":"
Loop
s = s & CHR$(10)
If nPars MOD 10 = 0 Then
MsgBox s, 0, "Paragraph Text Sections"
s = ""
End If
End If
nn = nn + 1
Loop
MsgBox s, 0, "Paragraph Text Sections"
End Sub
Sub WriterMacro()
Dim oDoc as Object, oText as Object
Dim oCursor as Object
Dim oFile as String, oURL as String
oDoc = ThisComponent
oText = oDoc.getText()
oCursor = oText.createTextCursor()
'
oFile = "c:\temp\oTextMacro.txt"
oURL = ConvertToUrl(oFile)
oCursor.insertDocumentFromUrl( oURL, Array() )
'
msgbox "Success"
End Sub
'
' [ Note ]
' Binary Fileは不可
[ Selected Text ]
Sub oWriterDocument
Dim oDoc
Dim oSelections
Dim oSel
Dim oCurs
'
IsAnythingSelected = fase
oDoc = ThisComponent
oSelections = oDoc.getCurrentSelection()
' case 1
If IsNull(oSelections) Then
oDisp = "Textが選択されていません。"
End If
'case 2
If oSelections.getCount() = 0 then
oDisp = "Textが選択されていません。"
End If
'case 3
If oSelections.getCount() > 1 then
oDisp = "複数のTextが選択されています。"
else
oSel = oSelections.getByIndex(0)
oCurs = oDoc.Text.CreateTextCursorByRange(oSel)
If Not oCurs.IsCollapsed() Then
IsAnythingSelected = True
End If
oDisp = "1つのTextが選択されています。"
End If
msgbox(oDisp, 0, "Selected Text")
End Sub
Sub oTextSelection
Dim oSels As Object
Dim oSel As Object
Dim lSelCount As Long
Dim lWhichSelection As Long
oDoc = ThisComponent
oSels = oDoc.getCurrentSelection()
If Not IsNull(oSels) Then
oSelCount = oSels.getCount() - 1
oDisp = "Selected Text => " & oSelCount & " 箇所です"
else
oDisp = "Selected Textがありません。"
End If
msgbox(oDisp, 0, "Selected Text")
End Sub
Sub oTextSelection
Dim oSels As Object
Dim oSel As Object
Dim oSelCount As Long
Dim oString
oDoc = ThisComponent
oSels = oDoc.getCurrentSelection()
If Not IsNull(oSels) Then
oSelCount = oSels.getCount() -1
oDisp = "[ Selected Text ]" & Chr$(10)
For i = 1 To oSelCount
oSel = oSels.getByIndex(i)
oString = oSel.getString()
oDisp = oDisp & i & ") " & oString
oDisp = oDisp & Chr$(10)
Next i
else
oDisp = "Selected Textがありません。"
End If
msgbox(oDisp, 0, "Selected Text")
End Sub
Sub oSelectedText
Dim oDoc
Dim oSlections
Dim oSelCount
Dim oSel
Dim oRange
oDoc = ThisComponent
oSelections = oDoc.getCurrentSelection()
oSelCount = oSelections.getCount()
print oSelCount
For i = 0 To oSelCount - 1
oSel = oSelections.getByIndex(i)
oRange = oSel.getStart()
oInsetText = Chr$(13) & " <<< Insert Text >>> " & Chr$(13)
oRange.setString(oInsetText)
next i
End Sub
Sub oSelectedText
Dim oDoc
Dim oSlections
Dim oSelCount
Dim oSel
Dim oRange
oDoc = ThisComponent
oSelections = oDoc.getCurrentSelection()
oSelCount = oSelections.getCount()
If oSelCount > 1 then
oSelCount = oSelCount-1
End If
For i = 0 To oSelCount - 1
oSel = oSelections.getByIndex(i)
oRange = oSel.getEnd()
oInsetText = Chr$(13) & " <<< Insert Text >>> " & Chr$(13)
oRange.setString(oInsetText)
next i
End Sub
Sub oSelectedText
Dim oDoc
Dim oText
Dim oSelections
Dim oSel
On Error Goto oBad
oDoc = ThisComponent
oText = oDoc.getText()
oSelections = oDoc.getCurrentSelection()
oSel = oSelections.getByIndex(0)
'
'Compare Paragrah
Dim oEnum
Dim oPar
oEnum = oText.createEnumeration()
nn = 1
Do While oEnum.hasMoreElements() and nn <100
oPar = oEnum.nextElement()
oCompare = oText.compareRegionStarts(oPar, oSel)
Select case oCompare
case =1
oDisp = oDisp & "Paragraph No. " & nn & " は選択範囲の文頭より前(左)から始まっている。" & Chr$(10)
case =0
oDisp = oDisp & "Paragraph No. " & nn & " は選択範囲の文頭と同じ位置から始まっている。" & Chr$(10)
case =-1
oDisp = oDisp & "Paragraph No. " & nn & " は選択範囲の文頭より後ろ(右)から始まっている。" & Chr$(10)
End Select
nn = nn+1
Loop
'
msgbox(oDisp)
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
Exit Sub
End Sub
Sub oSelectedText
Dim oDoc
Dim oText
Dim oSelections
Dim oSel
On Error Goto oBad
oDoc = ThisComponent
oText = oDoc.getText()
oSelections = oDoc.getCurrentSelection()
oSel = oSelections.getByIndex(0)
'
'Compare Paragrah
Dim oEnum
Dim oPar
oEnum = oText.createEnumeration()
nn = 1
Do While oEnum.hasMoreElements() and nn <100
oPar = oEnum.nextElement()
oCompare = oText.compareRegionEnds(oPar, oSel)
Select case oCompare
case =1
oDisp = oDisp & "Paragraph No. " & nn & " は選択範囲の文末より前(左)で終わっている。" & Chr$(10)
case =0
oDisp = oDisp & "Paragraph No. " & nn & " は選択範囲の文末と同じ位置で終わっている。" & Chr$(10)
case =-1
oDisp = oDisp & "Paragraph No. " & nn & " は選択範囲の文末より後ろ(右)で終わっている。" & Chr$(10)
End Select
nn = nn+1
Loop
'
msgbox(oDisp,0,"選択範囲と各Paragraphの位置関係")
Exit Sub
oBad:
Dim oErLine As Integer
Dim oErNum As Integer
Dim oErMsg As String
oErLine = Erl
oErNum = Err
oErMsg = Error
Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
Exit Sub
End Sub
Sub oSelectedText
Dim oDoc
Dim oSlections
Dim oSel
Dim oCursor
oDoc = ThisComponent
oSelections = oDoc.CurrentSelection()
oSel = oSelections.getByIndex(0)
oRangeL = oSel.getStart()
oRangeR = oSel.getEnd()
oCurL = oSel.getText().CreateTextCursorByRange(oRangeL)
oCurR = oSel.getText().CreateTextCursorByRange(oRangeR)
'
oCurL.goLeft(0, False)
'
Dim oText
oText = oCurL.getText()
oCurL.goRight(0, False)
nn = 1
Do While oCurL.goRight(1, True) AND oText.compareRegionEnds(oCurL, oCurR) >= 0 AND nn < 100
oDisp_temp = oCurL.getString()
msgbox(oDisp_temp, 0, "選択文字を１文字づつ表示")
oDisp = oDisp & oDisp_temp & Chr$(13)
oCurL.goRight(0, False)
nn =nn +1
Loop
msgbox(oDisp, 0, "選択範囲を縦書き表示")
End Sub
Sub oSelectedText
Dim oDoc
Dim oSlections
Dim oSel
Dim oCursor
oDoc = ThisComponent
oSelections = oDoc.CurrentSelection()
oSel = oSelections.getByIndex(0)
'修正前の文字取得
oSelectedStr1 = oSel.getString
oDisp = oSelectedStr1
oDisp = oDisp & Chr$(10) & Chr$(10) & " から" & Chr$(10) & Chr$(10)
'
oRangeL = oSel.getStart()
oRangeR = oSel.getEnd()
oCurL = oSel.getText().CreateTextCursorByRange(oRangeL)
oCurR = oSel.getText().CreateTextCursorByRange(oRangeR)
'
oCurL.goLeft(0, False)
'
Dim oText
oText = oCurL.getText()
Dim oLastChar As Integer
Dim oThisChar As Integer
Dim oRank As Integer
Dim oCharNum as Integer
Dim oString as String
Dim oStop As Integer
oLastChar = 0
oThisChar = 0
oCurL.goRight(0, False)
nn = 1 ' <= 無限Loop防止用
oCharNum = 1 ' <= 取得する文字数設定
Do While oCurL.goRight(oCharNum, True) and nn < 10000
oString = oCurL.getString() ' <= 1文字(oCharNumにて設定)取得
oThisChar = Asc(oString)
' '
oStop = oText.compareRegionEnds(oCurL, oCurR) ' <= 選択範囲の終わりの確認
'
If oStop = 0 Then ' <= 選択範囲End時
Exit Do
End If
'選択範囲を超してしまった場合
If i < 0 Then Exit Do
'
'Spaceかどうかの判断
oRank = IsWhiteSpace(oThisChar)
' oo = ASC(" ")
' print oo
' print oThisChar
' print oRank
'
'選択文字がSpaceの場合
If oRank = 1 Then
oCurL.setString("")
End If
'選択文字が改行/Tab/改ページ( Chr$(9) / Chr$(10) / Chr$(13) / Chr$(32) / Chr$(160) )の場合
If iRank = -1 Then
'削除せずに前に詰める。
oCurL.goLeft(2, True)
oCurL.setString("")
oCurL.goRight(1, False)
oLastChar = oThisChar
Else
'選択文字が空白、改行、Tab、改ページ以外の時
oCurL.goRight(0, False)
oLastChar = oThisChar
End If
Loop
'修正後の文字取得
oSelections = oDoc.CurrentSelection()
oSel = oSelections.getByIndex(0)
'
oSelectedStr2 = oSel.getString
oDisp = oDisp & oSelectedStr2
oDisp = oDisp & Chr$(10) & Chr$(10) & " に変更されました。"
' Display
msgbox(oDisp, 0, "選択範囲内のSpaceを削除")
End Sub
'[ Function 1 ]
Function IsWhiteSpace(iChar As Integer) As Variant
Select Case iChar
Case 9, 10, 13
IsWhiteSpace = -1
Case 32, 12288 ' <= 半角Space：32 全角スペース：12288
IsWhiteSpace = 1
Case Else
IsWhiteSpace = 0
End Select
End Function
Sub oSelectedText
Dim oDoc
Dim oSlections
Dim oSel
Dim oCursor
oDoc = ThisComponent
oSelections = oDoc.CurrentSelection()
oSel = oSelections.getByIndex(0)
'修正前の文字取得
oSelectedStr1 = oSel.getString
oDisp = "「 " & oSelectedStr1 & " 」"
oDisp = oDisp & Chr$(10) & Chr$(10) & " から" & Chr$(10) & Chr$(10)
'
oRangeL = oSel.getStart()
oRangeR = oSel.getEnd()
oCurL = oSel.getText().CreateTextCursorByRange(oRangeL)
oCurR = oSel.getText().CreateTextCursorByRange(oRangeR)
'
' Sub RemoveEmptyParsWorker(oLCurs As Object, oRCurs As Object)
Dim oParText As String
Dim oParNum As Integer
Dim oText
oText = oDoc.getText()
' 選択範囲が無いかのcheck
' Check1
If IsNull(oCurL) Or IsNull(oCurR) Or IsNull(oSel) Then Exit Sub
'
oCurL.goRight(0, False)
nn = 1 ' <= 無限Loop防止
Do While oCurL.gotoNextParagraph(TRUE) AND oText.compareRegionEnds(oCurL, oCurR) > 0 and nn < 1000
oParText = oCurL.getString()
oParNum = Len(oParText)
'
mm = 1
Do While oParNum > 0 and mm < 1000
If (Mid(oParText, oParNum, 1) = Chr(10)) OR (Mid(oParText, oParNum, 1) = Chr(13)) Then
oParNum = oParNum - 1
Else
oParNum = -1
End If
mm = mm + 1
Loop
'空Paragraph削除
If oParNum = 0 Then
oCurL.setString("")
Else
oCurL.goLeft(0,FALSE)
End If
nn = nn + 1
Loop
'修正後の文字取得
oSelections = oDoc.CurrentSelection()
oSel = oSelections.getByIndex(0)
'
oSelectedStr2 = oSel.getString
oDisp = oDisp & "「 " & oSelectedStr2 & " 」"
oDisp = oDisp & Chr$(10) & Chr$(10) & " に変更されました。"
' Display
msgbox(oDisp, 0, "Empty Paragraphの削除")
End Sub
Sub oMultipleTextSelectionExample
Dim oSels As Object
Dim oSel As Object
Dim lSelCount As Long
Dim lWhichSelection As Long
oDoc = ThisComponent
oSels = oDoc.getCurrentSelection()
If Not IsNull(oSels) Then
lSelCount = oSels.getCount()
For lWhichSelection = 0 To lSelCount - 1
oSel = oSels.getByIndex(lWhichSelection)
MsgBox oSel.getString()
Next
End If
End Sub
[ Cursor ]
Sub oCurrentCursorPosition()
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm"
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
Sub oPage()
Dim oDoc
Dim oViewCursor
Dim oPageStyle
Dim oPStyle
Dim oCursorPos
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
oPageStyle = oViewCursor.PageStyleName
oPStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oPageStyle)
'Page Size
oHeight = oPStyle.Height /100 ' unit : 1/100 mm
oWidth = oPStyle.Width /100 ' unit : 1/100 mm
'Charactor Size
oCharSize1A = oViewCursor.CharHeight ' unit : mm
oCharSizeAsian = oViewCursor.CharHeightAsian ' unit : mm
If oCharSize1A >= oCharSizeAsian then
oCharSize = oCharSize1A
else
oCharSize = oCharSizeAsian
End If
'Page Margin
oTopMargin = oPStyle.TopMargin /100 ' unit : 1/100mm
oBottomMargin = oPStyle.BottomMargin /100 ' unit : 1/100mm
oLeftMargin = oPStyle.LeftMargin /100 ' unit : 1/100mm
oRightMargin = oPStyle.RightMargin /100 ' unit : 1/100mm
'Cursor Position
oCursorPos = oViewCursor.getPosition()
'Top
oTopPos = oCursorPos.Y /100 + oTopMargin + oCharSize/2
'Bottom
oBottomPos = oHeight - oTopPos
'Left
oLeftPos = oCursorPos.X/100 + oLeftMargin
'Right
oRightPos = oWidth - oLeftPos
oDisp = "[ Cursor Position in Page ] " & Chr$(10) & _
"From Top : " & oTopPos & "mm" & Chr$(10) & _
"From Bottom : " & oBottomPos & "mm" & Chr$(10) & _
"From Left : " & oLeftPos & "mm" & Chr$(10) & _
"From Right : " & oRightPos & "mm"
msgbox(oDisp,0,"Page")
End Sub
Sub oGotoDocStart()
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
'現在のCursor位置を取得
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
Chr$(10) & " の位置から " & Chr$(10)& Chr$(10)
'Cursor位置をDocumentの先頭に移動
oViewCursor.gotoStart(False)
'Confirm
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = oDisp & "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
" の位置に移動しました。"
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
Sub oGotoDocEnd()
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
'現在のCursor位置を取得
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
Chr$(10) & " の位置から " & Chr$(10)& Chr$(10)
'Cursor位置をDocumentのEndに移動
oViewCursor.gotoEnd(False)
'Confirm
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = oDisp & "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
" の位置に移動しました。"
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
Sub oGotoCursor()
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
'現在のCursor位置を取得
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
Chr$(10) & " の位置から " & Chr$(10)& Chr$(10)
'Cursor位置をLineのStartに移動
oViewCursor.gotoStartOfLine(False)
'Confirm
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = oDisp & "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
" の位置に移動しました。"
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
Sub oGotoCursor()
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
'現在のCursor位置を取得
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
Chr$(10) & " の位置から " & Chr$(10)& Chr$(10)
'Cursor位置をLineのStartに移動
oViewCursor.gotoEndOfLine(False)
'Confirm
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = oDisp & "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
" の位置に移動しました。"
oMRI = CreateUnoService("mytools.Mri")
oMRI.inspect(oViewCursor)
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
Sub oGotoCursor()
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
'現在のCursor位置を取得
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
Chr$(10) & " の位置から " & Chr$(10)& Chr$(10)
'Cursor位置を移動
oViewCursor.goLeft(2,false)
'Confirm
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = oDisp & "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
" の位置に移動しました。"
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
Sub oGotoCursor()
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
'現在のCursor位置を取得
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
Chr$(10) & " の位置から " & Chr$(10)& Chr$(10)
'Cursor位置を移動
Dim oFrame as Object
Dim oDispatcher as Object
oFrame = oCtrl.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:GoLeft", "", 0, Array()) ' 1 time
oDispatcher.executeDispatch(oFrame, ".uno:GoLeft", "", 0, Array()) ' 2 time
'
'Confirm
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = oDisp & "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
" の位置に移動しました。"
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
Sub oGotoCursor
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
'現在のCursor位置を取得
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
Chr$(10) & " の位置から " & Chr$(10)& Chr$(10)
'Cursor位置を移動
oViewCursor.goRight(2,false)
'Confirm
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = oDisp & "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
" の位置に移動しました。"
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
Sub oGotoCursor()
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
'現在のCursor位置を取得
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
Chr$(10) & " の位置から " & Chr$(10)& Chr$(10)
'Cursor位置を移動
Dim oFrame as Object
Dim oDispatcher as Object
oFrame = oCtrl.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:GoRight", "", 0, Array()) ' 1 time
oDispatcher.executeDispatch(oFrame, ".uno:GoRight", "", 0, Array()) ' 2 time
'
'Confirm
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = oDisp & "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
" の位置に移動しました。"
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
Sub oGotoCursor()
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
'現在のCursor位置を取得
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
Chr$(10) & " の位置から " & Chr$(10)& Chr$(10)
'Cursor位置を移動
oViewCursor.goDown(2,false)
'Confirm
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = oDisp & "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
" の位置に移動しました。"
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
Sub oGotoCursor()
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
'現在のCursor位置を取得
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
Chr$(10) & " の位置から " & Chr$(10)& Chr$(10)
'Cursor位置を移動
Dim oFrame as Object
Dim oDispatcher as Object
oFrame = oCtrl.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:GoDown", "", 0, Array()) ' 1 time
oDispatcher.executeDispatch(oFrame, ".uno:GoDown", "", 0, Array()) ' 2 time
'
'Confirm
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = oDisp & "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
" の位置に移動しました。"
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
Sub oGotoCursor
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
'現在のCursor位置を取得
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
Chr$(10) & " の位置から " & Chr$(10)& Chr$(10)
'Cursor位置を移動
oViewCursor.goUp(2,false)
'Confirm
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = oDisp & "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
" の位置に移動しました。"
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
Sub oGotoCursor()
Dim oDoc as Object
Dim oCtrl as Object
Dim oViewCursor as object
Dim oCurPos as Object
oDoc = ThisComponent
'現在のCursor位置を取得
oCtrl = oDoc.getCurrentController()
oViewCursor = oCtrl.getViewCursor()
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
Chr$(10) & " の位置から " & Chr$(10)& Chr$(10)
'Cursor位置を移動
Dim oFrame as Object
Dim oDispatcher as Object
oFrame = oCtrl.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:GoUp", "", 0, Array()) ' 1 time
oDispatcher.executeDispatch(oFrame, ".uno:GoUp", "", 0, Array()) ' 2 time
'
'Confirm
oCurPos = oViewCursor.getPosition
oCurrentCurX = oCurPos.X / 100
oCurrentCurY = oCurPos.Y / 100
oDisp = oDisp & "左から " & oCurrentCurX & " mm" & Chr$(10) & _
"上から " & oCurrentCurY & " mm" & Chr$(10) & _
" の位置に移動しました。"
msgbox(oDisp, 0, "現在のCursor位置 in Writer")
End Sub
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")
' End of Next Page / Cursorも移動する
oDispatcher.executeDispatch( oFrame, ".uno:GoToEndOfNextPage", "", 0, Array())
msgbox "End of Next Page View",0,"Scroll View"
' End of Previous Page / Cursorも移動する
oDispatcher.executeDispatch( oFrame, ".uno:GoToEndOfPrevPage", "", 0, Array())
msgbox "End odPrevious Page View",0,"Scroll View"
End Sub
Sub WriterCursor()
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")
' Start of Next Page / Cursorも移動する
oDispatcher.executeDispatch( oFrame, ".uno:GoToStartOfNextPage", "", 0, Array()) ' ← 動作しない。LO4.0.3
msgbox "End of Next Page View",0,"Scroll View"
' Start of Previous Page / Cursorも移動する
oDispatcher.executeDispatch( oFrame, ".uno:GoToStartOfPrevPage", "", 0, Array()) ' ← 動作する。LO4.0.3
msgbox "End odPrevious Page View",0,"Scroll View"
End Sub
[ Count ]
Sub oParagraph
Dim oDoc
Dim oText
Dim oStext
Dim oEText
Dim oEnum ' com.sun.star.container.XEnumerationAccess
Dim oPar
Dim oNumPar
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oDisp = "Paragraph No.1の開始です。" & Chr$(10) & _
"ここもParagraph No.1です。" & Chr$(13) & _
"ここからはPragraph No.2です。" & Chr$(10) & _
"ここもParagraph No.2です。従ってParagraph数は2です。"
oText.insertString(oText.getEnd(), oDisp, false) '文末
'Count Paragrah
oEnum = oDoc.Text.createEnumeration()
Do While oEnum.hasMoreElements()
oPar = oEnum.nextElement()
If oPar.SupportsService("com.sun.star.text.Paragraph") then
oNumPar = oNumPar + 1
End If
Loop
oDisp = "Paragraph Num => " & oNumPar
msgbox(oDisp, 0, "In Document")
End Sub
Sub oParagraph
Dim oDoc
Dim oText
Dim oNumPar
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oDisp = "Paragraph No.1の開始です。" & Chr$(10) & _
"ここもParagraph No.1です。" & Chr$(13) & _
Chr$(9) & Chr$(9) & Chr$(9) &"ここからはPragraph No.2です。" & Chr$(10) & _
"ここもParagraph No.2です。従ってParagraph数は2です。"
oText.insertString(oText.getEnd(), oDisp, false) '文末
'Count Paragrah
oNumPar = oDoc.ParagraphCount
oDisp = "Paragraph Num => " & oNumPar
msgbox(oDisp, 0, "Paragraph数")
End Sub
Sub oParagraph
Dim oDoc
Dim oText
Dim oCur
Dim oNumSentence
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oDisp = "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$(13) & _
"This line is fourth paragraph. It is fifth line."
oText.insertString(oText.getEnd(), oDisp, false)
'Count Sentence
oCur = oText.createTextCursor
nn = 0
oNumSentence = 1
Do While oCur.gotoNextSentence(true) and nn <100
oNumSentence = oNumSentence + 1
Loop
oDisp = "本DocumentのSentence数は" & Chr$(10)
oDisp = oDisp & oNumSentence
oDisp = oDisp & " です。"
msgbox(oDisp,0,"Sentence数取得")
End Sub
Sub CountSentences
Dim oCursor 'A text cursor.
Dim oSentenceCursor 'A text cursor.
Dim oText
Dim i
oText = ThisComponent.Text
oCursor = oText.CreateTextCursor()
oSentenceCursor = oText.CreateTextCursor()
'Move the cursor to the start of the document
oCursor.GoToStart(False)
Do While oCursor.gotoNextParagraph(True)
'At this point, you have the entire paragraph highlighted
oSentenceCursor.gotoRange(oCursor.getStart(), False)
Do While oSentenceCursor.gotoNextSentence(True) AND oText.compareRegionEnds(oSentenceCursor, oCursor) >= 0
oSentenceCursor.goRight(0, False)
i = i + 1
Loop
oCursor.goRight(0, False)
Loop
MsgBox i, 0, "Number of Sentences"
End Sub
Sub oSelectedText
Dim oDoc
Dim oSlections
Dim oSel
Dim oCursor
oDoc = ThisComponent
oSelections = oDoc.CurrentSelection()
oSel = oSelections.getByIndex(0)
oRangeL = oSel.getStart()
oRangeR = oSel.getEnd()
oCurL = oSel.getText().CreateTextCursorByRange(oRangeL)
oCurR = oSel.getText().CreateTextCursorByRange(oRangeR)
'
oCurL.goLeft(0, False)
'
Dim oText
oText = oCurL.getText()
oCurL.goRight(0, False)
nn = 1
Do While oCurL.goRight(1, True) AND oText.compareRegionEnds(oCurL, oCurR) >= 0 AND nn < 100
oDisp_temp = oCurL.getString()
oDisp = oDisp & nn & ") " & oDisp_temp & Chr$(13)
oCurL.goRight(0, False)
nn =nn +1
Loop
' Count Charactor
oNumChar = oDoc.CharacterCount
oDisp = oDisp & Chr$(13) & Chr$(13) &"Charactor Num => " & oNumChar
oDisp = oDisp & Chr$(10) & "改Paragraph(Chr$(13)はCountしませんが"
oDisp = oDisp & Chr$(10) & "改Line(Chr$(10)や"
oDisp = oDisp & Chr$(10) & "Tab(Chr$(9)はCountします。"
msgbox(oDisp, 0, "Charactor数")
End Sub
Sub oDocument
Dim oDoc
Dim oText
Dim oCur
Dim oNumWord
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oDisp1 = "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."
oText.insertString(oText.getEnd(), oDisp1, false)
'Count Sentence
oCur = oText.createTextCursor
nn = 0
oNumWord = 1
Do While oCur.gotoNextWord(true) and nn <100
oNumWord = oNumWord + 1
Loop
oDisp = "本DocumentのWord数は" & Chr$(10)
oDisp = oDisp & oNumWord-1
oDisp = oDisp & " です。"
msgbox(oDisp,0,"Word数取得")
End Sub
Sub oDocument
Dim oDoc
Dim oText
Dim oCur
Dim oNumWord
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oDisp1 = "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."
oText.insertString(oText.getEnd(), oDisp1, false)
'Count Sentence
oCur = oText.createTextCursor
nn = 0
oNumWord = 1
Do While oCur.gotoNextWord(true) and nn <100
oWord_temp = oCur.String
oDisp = oDisp & oNumWord & ") " & oWord_temp & Chr$(10)
'
oNumWord = oNumWord + 1
Loop
oDisp = oDisp & Chr$(10) & "本DocumentのWord数は" & Chr$(10)
oCountWord = oDoc.WordCount
oDisp = oDisp & oCountWord
oDisp = oDisp & " です。"
msgbox(oDisp,0,"Word数取得")
End Sub
Page
Sub oPage
Dim oDoc
Dim oViewCursor
Dim oPageStyle
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
oPageStyle = oViewCursor.PageStyleName
oDisp = oPageStyle
msgbox(oDisp,0,"Page")
End Sub
Sub oPage
Dim oDoc
Dim oViewCursor
Dim oPageStyle
Dim oPStyle
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
oPageStyle = oViewCursor.PageStyleName
oPStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oPageStyle)
'Page Size
oHeight = oPStyle.Height /100 ' unit : 1/100 mm
oWidth = oPStyle.Width /100 ' unit : 1/100 mm
oDisp = "Page Heiht : " & Int(oHeight) & "mm" & Chr$(10) & _
"Page Width : " & Int(oWidth) & "mm"
msgbox(oDisp,0,"Page")
End Sub
Sub oPage
Dim oDoc
Dim oViewCursor
Dim oCharSize
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
oCharSize = oViewCursor.CharHeight ' unit : mm
oDisp = "Charactor Size : " & oCharSize & "mm"
msgbox(oDisp,0,"Page")
End Sub
Sub oPage
Dim oDoc
Dim oViewCursor
Dim oCharSize
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
oCharSize = oViewCursor.CharHeightAsian ' unit : mm
oDisp = "Asian Charactor Size : " & oCharSize & "mm"
msgbox(oDisp,0,"Page")
End Sub
Sub oPage
Dim oDoc
Dim oViewCursor
Dim oCharSize
Dim document as object
Dim dispatcher as object
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
' Pre-Size
oCharSize1 = oViewCursor.CharHeight ' unit : mm
'Dispatch
document = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'Charactor Size Set
Dim oArgs1(2) as new com.sun.star.beans.PropertyValue
oArgs1(0).Name = "FontHeight.Height"
oArgs1(0).Value = 12
dispatcher.executeDispatch(document, ".uno:FontHeight", "", 0, oArgs1())
'Confirm
oCharSize2 = oViewCursor.CharHeight ' unit : mm
'Display
oDisp = " [ Charactor Size ] " & CHr$(10) & _
oCharSize1 & "mm => " & _
oCharSize2 & "mm"
msgbox(oDisp,0,"Page")
End Sub
Sub oPage
Dim oDoc
Dim oViewCursor
Dim oCharSize
Dim document as object
Dim dispatcher as object
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
' Pre-Size
oCharSize1 = oViewCursor.CharHeightAsian ' unit : mm
'Dispatch
document = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'Charactor Size Set
Dim oArgs1(0) as new com.sun.star.beans.PropertyValue
oArgs1(0).Name = "FontHeightCJK.Height"
oArgs1(0).Value = 12
dispatcher.executeDispatch(document, ".uno:FontHeightCJK", "", 0, oArgs1())
'Confirm
oCharSize2 = oViewCursor.CharHeightAsian ' unit : mm
'Display
oDisp = " [ Asian Charactor Size ] " & CHr$(10) & _
oCharSize1 & "mm => " & _
oCharSize2 & "mm"
msgbox(oDisp,0,"Page")
End Sub
Sub oCursorPageNo
Dim oDoc as Object
Dim oViewCursor as Object
Dim oCursorPageNumber as Long
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
oCursorPageNumber = oViewCursor.getPage()
oDisp = "Current Page No. : " & oCursorPageNumber
msgbox(oDisp,0,"Page")
End Sub
Sub oPage
Dim oDoc
Dim oViewCursor
Dim oPageStyle
Dim oPStyle
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
oPageStyle = oViewCursor.PageStyleName
oPStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oPageStyle)
'Margin
oTopMargin = oPStyle.TopMargin /100 ' unit : 1/100mm
oBottomMargin = oPStyle.BottomMargin /100 ' unit : 1/100mm
oLeftMargin = oPStyle.LeftMargin /100 ' unit : 1/100mm
oRightMargin = oPStyle.RightMargin /100 ' unit : 1/100mm
oDisp = "[ Page Margin ] " & Chr$(10) & _
"Top : " & oTopMargin & "mm" & Chr$(10) & _
"Bottom : " & oBottomMargin & "mm" & Chr$(10) & _
"Left : " & oLeftMargin & "mm" & Chr$(10) & _
"Right : " & oRightMargin & "mm"
msgbox(oDisp,0,"Page")
End Sub
Sub oPage
Dim oDoc
Dim oViewCursor
Dim oPageStyle
Dim oPStyle
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
oPageStyle = oViewCursor.PageStyleName
oPStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName(oPageStyle)
'Pre-Margin
oPreTopMargin = oPStyle.TopMargin /100 ' unit : 1/100mm
'Set Margin
oPStyle.TopMargin = 10*100
'Confirm
oTopMargin = oPStyle.TopMargin /100 ' unit : 1/100mm
oDisp = "[ Margin Set ] " & Chr$(10) & _
"Top Margin : " & oPreTopMargin & "mm => " & oTopMargin & " mm"
msgbox(oDisp,0,"Page")
End Sub
Sub PageStylePageNo
Dim oDoc As Object
Dim oText as Object
Dim oSelections as Object
Dim oSel as Object
Dim oLCurs as Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oString = "This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. "
oText.insertString(oText.getEnd(), oString, false)
'
oSelections = oDoc.getCurrentSelection()
'
oSel = oSelections.getByIndex(0)
oLCurs = oText.CreateTextCursorByRange(oSel)
'
' PageStyleのPage No. 取得
Dim oPageNum1 as Long
oPageNum1 = oLCurs.PageNumberOffset + 1
oDisp = "PageStyleの最初のPage番号 => " & oPageNum1
'
msgbox (oDisp, 0,"PageStyleのPage番号取得")
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
Sub PageStylePageNo
Dim oDoc As Object
Dim oText as Object
Dim oSelections as Object
Dim oSel as Object
Dim oLCurs as Object
Dim Dummy()
On Error Goto oBad
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oText = oDoc.getText()
oString = "This line is first paragraph and first line." & Chr$(10) & _
Chr$(9) & "This line is first paragraph too." & Chr$(13) & _
Chr$(9) & Chr$(9) & "This line is second paragraph. "
oText.insertString(oText.getEnd(), oString, false)
'
oSelections = oDoc.getCurrentSelection()
'
oSel = oSelections.getByIndex(0)
oLCurs = oText.CreateTextCursorByRange(oSel)
'
' PageStyleのPage No. 取得
Dim oPageNum1 as Long
Dim oPageNum2 as Long
oPageNum1 = oLCurs.PageNumberOffset + 1
'
oDisp = "PageStyleの最初のPage番号 => " & oPageNum1 & Chr$(10)
oDisp = oDisp & Chr$(10)
' 改Page
oLCurs.PageDescName = oLCurs.PageStyleName
' 同じPageStyleの改Page後のPage No. 設定
oLCurs.PageNumberOffset = 7
' Confirm
oPageNum2 = oLCurs.PageNumberOffset
oDisp = oDisp & "同じPageStyleの改Page後のPage番号 => " & oPageNum2
msgbox (oDisp, 0,"PageStyleのPage番号取得")
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
Sub ParagraphWriter()
Dim oDoc as Object
Dim oDText as Object
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oDText = oDoc.getText()
oDisp = "This line is first page." & Chr$(13) & _
"This line is second paragraph. It is third line.(Second Page)" & Chr$(13) & _
"This line is third paragraph. It is fourth line.(Center)" & Chr$(13) & _
"This line is fourth paragraph. It is fifth line.(Block)" & Chr$(13) & _
"This line is fifth paragraph. It is fifth line.(Stretch)"
oDText.insertString(oDText.getEnd(), oDisp, false)
'Count Paragrah
oNumPar = oDoc.ParagraphCount
'
'Paragraph 内容取得
oEnum = oDText.createEnumeration()
m = 0
Do While oEnum.hasMoreElements() and m < 10000
oPar = oEnum.nextElement()
If oPar.SupportsService("com.sun.star.text.Paragraph") then
Select case m
case 0
' Paragpahの後に改Page設定
oPar.BreakType = com.sun.star.style.BreakType.PAGE_AFTER ' = 5
case 1
' Paragpahの前に改Page設定 ← 既に改Page設定されている時は変化無し
oPar.BreakType = com.sun.star.style.BreakType.PAGE_BEFORE ' = 4
case 2
' Paragpahの前後に改Page設定
oPar.BreakType = com.sun.star.style.BreakType.PAGE_BOTH ' = 6
case 3
' 段組みをしている時、Paragrahの前後を改Column
oPar.BreakType = com.sun.star.style.BreakType.COLUMN_BOTH ' = 3
case 4
' 改Page、改Column無し
oPar.BreakType = com.sun.star.style.BreakType.NONE ' = 0
End Select
End If
m = m + 1
msgbox oPar.BreakType
Loop
End Sub
'
' [ Note ]
' com.sun.star.style.BreakType( LibreOffile / Apache OpenOffice )
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")
' Next Page
oProp(0).Name = "ScrollNextPrev"
oProp(0).Value = True
oDispatcher.executeDispatch( oFrame, ".uno:ScrollNextPrev", "", 0, oProp())
msgbox "Next Page View",0,"Scroll View"
' Previous Page
oProp(0).Name = "ScrollNextPrev"
oProp(0).Value = False
oDispatcher.executeDispatch( oFrame, ".uno:ScrollNextPrev", "", 0, oProp())
msgbox "Previous Page View",0,"Scroll View"
End Sub
[ Header / Footer ]
Paragraph Property
Sub oParagraph
Dim oDoc
Dim oDText
Dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
oDText = oDoc.getText()
oDisp = "This line is first paragraph. This is first line.(Left)" & Chr$(13) & _
"This line is second paragraph. It is third line.(Right)" & Chr$(13) & _
"This line is third paragraph. It is fourth line.(Center)" & Chr$(13) & _
"This line is fourth paragraph. It is fifth line.(Block)" & Chr$(13) & _
"This line is fifth paragraph. It is fifth line.(Stretch)"
oDText.insertString(oDText.getEnd(), oDisp, false)
'Count Paragrah
oNumPar = oDoc.ParagraphCount
'
'Paragraph 内容取得
oEnum = oDText.createEnumeration()
m = 0
Do While oEnum.hasMoreElements() and m < 10000
oPar = oEnum.nextElement()
If oPar.SupportsService("com.sun.star.text.Paragraph") then
Select case m
case 0
oPar.ParaAdjust = com.sun.star.style.ParagraphAdjust.LEFT
case 1
oPar.ParaAdjust = com.sun.star.style.ParagraphAdjust.RIGHT
case 2
oPar.ParaAdjust = com.sun.star.style.ParagraphAdjust.CENTER
case 3
oPar.ParaAdjust = com.sun.star.style.ParagraphAdjust.BLOCK
case 4
oPar.ParaAdjust = com.sun.star.style.ParagraphAdjust.STRETCH
End Select
End If
m = m + 1
Loop
End Sub
