Home of site


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

Writer No.1


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

File

[ Open / Close ]


[ File Property ]


Document

[ Font ]


[ Text ]


[ Selected Text ]


[ Cursor ]


[ Count ]


Page


[ Header / Footer ]


Paragraph Property





###【 Next Page( Writer No.2) 】###











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

File

[ Open / Close ]

WF-1)[Writer]新規にWriter fileを開く

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

WF-2)[Writer]新規Writer fileの開閉(保存確認有り)

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

WF-3)[Writer]新規にHTML形式 fileを開く

Sub oWriter_HTML_Web_Doc
dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter/web", "_blank", 0, Dummy())
End Sub

WF-4)[Writer]新規にMaster Document(odmL形式) fileを開く

Sub oGlobalDoc
dim Dummy()
oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter/GlobalDocument", "_blank", 0, Dummy())
End Sub

[ File Property ]

WDPp-)[Writer]IndexAutoMarkFileURL


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

WDPp-)[Writer]WordSeparator


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 ]

WDF-)[Writer]文字列の右1文字を上付文字にする


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

WDF-)[Writer]文字列の左1文字を下付文字にする


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

WDF-)[Writer]英文字を80、日本語を40サイズにする


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

WDF-)[Writer]文字Font

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

WDF-)[Writer]Itaric


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

WDF-)[Writer]OBLIQUE


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

WDF-)[Writer]REVERSE_ITALIC


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

WDF-)[Writer]REVERSE_OBLIQUE


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

WDF-)[Writer]BOLD


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

WDF-)[Writer]SEMIBOLD


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

WDF-)[Writer]ULTRABOLD


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

WDF-)[Writer]BLACK


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

WDF-)[Writer]THIN


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

WDF-)[Writer]ULTRALIGHT


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

WDF-)[Writer]LIGHT


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

WDF-)[Writer]SEMILIGHT


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

WDF-)[Writer]SINGLE(下線)


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

WDF-)[Writer]DOUBLE(下線)


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

WDF-)[Writer]DOTTED


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

WDF-)[Writer]DASH


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

WDF-)[Writer]LONGDASH


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

WDF-)[Writer]DASHDOT


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

WDF-)[Writer]DASHDOTDOT


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

WDF-)[Writer]SMALLWAVE


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

WDF-)[Writer]WAVE


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

WDF-)[Writer]DOUBLEWAVE


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

WDF-)[Writer]BOLD


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

WDF-)[Writer]BOLDDOTTED


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

WDF-)[Writer]BOLDDASH


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

WDF-)[Writer]BOLDLONGDASH


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

WDF-)[Writer]BOLDDASHDOT


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

WDF-)[Writer]BOLDDASHDOTDOT


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

WDF-)[Writer]BOLDWAVE


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

WDF-)[Writer]下線色


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

WDF-)[Writer]下線と下線色

Sub GnlFont()
	Dim oDoc As Object, oText As Object, oCur as Object
	Dim oCtrl as Object, oFrame as Object
	Dim Dummy() 
	Dim oDispatcher as Object
	Dim oProp(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

WDF-)[Writer]上線と上線色

Sub GnlFont()
	Dim oDoc As Object, oText As Object, oCur as Object
	Dim oCtrl as Object, oFrame as Object
	Dim Dummy() 
	Dim oDispatcher as Object
	Dim oProp(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

WDF-)[Writer]影付き文字(1)


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

WDF-)[Writer]影付き文字(2)

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

WDF-)[Writer]取り消し線1


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

WDF-)[Writer]取り消し線2


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

WDF-)[Writer]取り消し線3


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

WDF-)[Writer]取り消し線4


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

WDF-)[Writer]取り消し線5


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

WDF-)[Writer]取り消し線(CrossedOut)[1]


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

WDF-)[Writer]取り消し線(CrossedOut)[2]

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

WDF-)[Writer]CaseMap1


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

WDF-)[Writer]CaseMap2


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

WDF-)[Writer]CaseMap3


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

WDF-)[Writer]CaseMap4


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

WDF-)[Writer]点滅

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

WDF-)[Writer]Space & Tabには下線や取消線を引かない


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

WDF-)[Writer]中抜き文字(1)


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

WDF-)[Writer]中抜き文字(2)

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

WDF-)[Writer]強調文字(上付DOT)


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

WDF-)[Writer]強調文字(上付Circle)


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

WDF-)[Writer]強調文字(上付Disk)


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

WDF-)[Writer]強調文字(上付Accent)


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

WDF-)[Writer]強調文字(下付DOT)


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

WDF-)[Writer]強調文字(下付Circle)


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

WDF-)[Writer]強調文字(下付Disk)


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

WDF-)[Writer]強調文字(下付Accent)


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

WDF-)[Writer]浮き出し文字


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

WDF-)[Writer]浮き彫り文字


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

WDF-)[Writer]浮き出し/浮き彫り文字

Sub GnlFont()
	Dim oDoc As Object, oText As Object, oCur as Object
	Dim oCtrl as Object, oFrame as Object
	Dim Dummy() 
	Dim oDispatcher as Object
	Dim oProp(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

WDF-)[Writer]Auto Kerning

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

WDF-)[Writer]背景色


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

WDF-)[Writer]背景を透明にする


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

WDF-)[Writer]Font Style


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

WDF-)[Writer]Font Name


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

WDF-)[Writer]CharFontNameComplex


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 ]

WD-)[Writer]文字入力

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

WD-)[Writer]Documentの最初に文字入力


Sub oCursorGotoinWriter
	Dim oDoc
	Dim oText
	Dim oCur
		oDoc = ThisComponent
		oText = oDoc.getText()
		oCur = oText.createTextCursor
		' 
		oCur.gotoStart(false)
		oCur.setString("「Documentの最初に追加した文です。」"
End Sub

WD-)[Writer]Documentの最後に文字入力


Sub oCursorGotoinWriter
	Dim oDoc
	Dim oText
	Dim oCur
		oDoc = ThisComponent
		oText = oDoc.getText()
		oCur = oText.createTextCursor
		' 
		oCur.gotoEnd(false)
		oCur.setString("「Documentの最初に追加した文です。」"
End Sub

WD-)[Writer]Documentの最初のParagraphのStart位置に文字挿入


Sub oCursorGotoinWriter
	Dim oDoc
	Dim oText
	Dim oCur
		oDoc = ThisComponent
		oText = oDoc.getText()
		oCur = oText.createTextCursor
		' 
		oCur.gotoStartOfParagraph(false)
		oCur.setString("「Macroにて追加した文です。」"
End Sub

WD-)[Writer]Documentの最初のParagraphのEndt位置に文字挿入


Sub oCursorGotoinWriter
	Dim oDoc
	Dim oText
	Dim oCur
		oDoc = ThisComponent
		oText = oDoc.getText()
		oCur = oText.createTextCursor
		' 
		oCur.gotoEndOfParagraph(false)
		oCur.setString("「Macroにて追加した文です。」"
End Sub

WD-)[Writer]Next Paragraph(2番目)のStart位置に文字入力


Sub oCursorGotoinWriter
	Dim oDoc
	Dim oText
	Dim oCur
		oDoc = ThisComponent
		oText = oDoc.getText()
		oCur = oText.createTextCursor
		' 
		oCur.gotoNextParagraph(false)
		oCur.setString("「Macroにて追加した文です。」"
End Sub

WD-)[Writer]Previous Paragraph(1番目)のStart位置に文字入力


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

WD-)[Writer]3th paragraphの後ろに文字入力


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

WD-)[Writer]文末から3th paragraphの前に文字入力


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

WD-)[Writer]2th Paragrah,2th Sentense, 4th Word, の1文字目と2文字目間にText入力


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

WDT-)[Writer]改Line入力(1)


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

WDT-)[Writer]改Line入力(2)


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

WDT-)[Writer]改Paragraph入力(1)


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

WDT-)[Writer]改Paragraph入力(2)


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

WDT-)[Writer]改Page入力(1)


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

WDT-)[Writer]改Page入力(2)


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

WDT-)[Writer]改Page削除


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

WDT-)[Writer]各Paragraphの内容取得


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

WDT-)[Writer]Paragrah Portion


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

WDT-)[Writer]Paragrah Portion


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 ]

WD-)[Writer]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

WD-)[Writer]選択箇所数取得


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

WD-)[Writer]選択Text取得


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

WD-)[Writer]選択範囲の右側に(前)文字入力


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

WD-)[Writer]選択範囲の左側(後)に文字入力


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

WD-)[Writer]選択範囲開始位置とParagraph文頭位置の比較


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

WD-)[Writer]選択範囲End位置とParagraph文末位置の比較


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

WD-)[Writer]選択範囲を1文字づつ取得 / 選択範囲を縦書表示


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, "選択文字を1文字づつ表示")
    			oDisp = oDisp & oDisp_temp & Chr$(13)
    			oCurL.goRight(0, False)
    			nn =nn +1
  			Loop
  			msgbox(oDisp, 0, "選択範囲を縦書き表示")
End Sub

WD-)[Writer]選択範囲のSpace削除


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

WD-)[Writer]選択範囲のEmpty Paragraphの削除


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

WD-)[Writer]複数の選択Textの取得

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 ]

WDCr-)[Writer]現在の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

WDCr-)[Writer]Page内のCursor位置取得


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

WDCr-)[Writer]Cursor位置をDocument先頭に移動


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

WDCr-)[Writer]Cursor位置をDocument Endに移動


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

WDCr-)[Writer]CursorをLine Start位置に移動


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

WDCr-)[Writer]CursorをLine End位置に移動


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

WDCr-)[Writer]Cursorを左に2文字移動(1)


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

WDCr-)[Writer]Cursorを左に2文字移動(2)

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

WDCr-)[Writer]Cursorを右に2文字移動(1)


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

WDCr-)[Writer]Cursorを右に2文字移動(2)

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

WDCr-)[Writer]Cursorを下に2行移動(1)


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

WDCr-)[Writer]Cursorを下に2行移動(2)

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

WDCr-)[Writer]Cursorを上に2行移動(1)


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

WDCr-)[Writer]Cursorを上に2行移動(2)

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

WDCr-)[Writer]Cursorを次/前Pageの文末に移動

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

WDCr-)[Writer]Cursorを次/前Pageの文前移動

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 ]

WPg-)[Writer]Pragrah数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

WDCnt-)[Writer]Pragrah数Count2


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

WD-)[Writer]Sentence数の取得1


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

WD-)[Writer]Sentence数の取得2


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

WDCnt-)[Writer]Charactor数Count


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

WD-)[Writer]Word数Count1


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

WDCnt-)[Writer]Word数Count2


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

WDCnt-)[Writer]











Page

WPage-)[Writer]Cursor位置のPageStyle取得


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

WPage-)[Writer]Cursor位置のPage Size取得


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

WPage-)[Writer]Chractor Size取得1


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

WPage-)[Writer]Chractor Size取得2


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

WPage-)[Writer]Chractor Size設定1


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

WPage-)[Writer]Chractor Size設定2


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

WPage-)[Writer]Cursor位置のPage番号取得


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



WPage-)[Writer]上下左右余白取得


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

WPage-)[Writer]余白設定


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

WPage-)[Writer]PageStyleの開始番号取得


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

WPage-)[Writer]同じPageStyleの改Page後のPage番号を設定


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

WPage-)[Writer]改行または改Pa挿入の種類と位置の取得/設定

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 )

WPage-)[Writer]Next/Previous Pageの表示( Cursor移動無し )

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

WPage-)[Writer]





[ Header / Footer ]

WPHF-)[Writer]




WPHF-)[Writer]





Paragraph Property

WPP-)[Writer]水平位置


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

WPP-)[Writer]




WPP-)[Writer]









Top of Page

inserted by FC2 system