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


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=100				'←設定方法?
			.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=100				'←設定方法?
			.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入力



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.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]改Paragraph入力



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]改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)
		'
		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削除



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, "選択文字を１文字づつ表示")
    			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]

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]

Search/Replace

WSR-)[Writer]Simple Search & Replace(1)



Sub oWriterStyle
  	Dim oDoc
  	Dim oWText
  	Dim oString
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
			oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
		oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
		'
		Dim oDescriptor
		Dim oFound
			oDescriptor = oDoc.createSearchDescriptor()
  			'
  			With oDescriptor
    			.SearchString = "This"
    			.SearchWords = true					' 完全一致の文字か?
    			.SearchCaseSensitive = False		' 大文字と小文字を区別するか?
  			End With
  			' 
  			oFound = oDoc.findFirst(oDescriptor)
  			nn = 1
  			Do While Not IsNull(oFound) and nn<1000
    			oFound.CharWeight = com.sun.star.awt.FontWeight.BOLD
    			oFound = oDoc.findNext( oFound.End, oDescriptor)
  			Loop
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WSR-)[Writer]Simple Search & Replace(2)



Sub oWriterSearchRepalce
  	Dim oDoc
  	Dim oWText
  	Dim oString
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
			oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
		oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
		'
		Dim oDescriptor
		Dim oFound
		Dim oFoundAll
			oDescriptor = oDoc.createSearchDescriptor()
  			'
  			With oDescriptor
    			.SearchString = "This"
    			.SearchWords = true					' 完全一致の文字か?
    			.SearchCaseSensitive = False		' 大文字と小文字を区別するか?
  			End With
  			' 
  			oFoundAll = oDoc.findAll(oDescriptor)
  			for i = o to oFoundAll.getCount()-1
  				oFound = oFoundAll.getByIndex(i)
  				Print oFound.getString()
  				oFound.setString("THIS")
  			next i
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WSR-)[Writer]複数のWordの置換



Sub oWriterSearchReplace
  	Dim oDoc
  	Dim oWText
  	Dim oString
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
			oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
		oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
		'
		Dim oReplace
		Dim oFound
		Dim oSearchWord(2) As String
		Dim oReplaceWord(2) As String
  		Dim n as long
			oSearchWord(0) = "writer"
			oSearchWord(1) = "line"
			oSearchWord(2) = "paragraph"
		'
			oReplaceWord(0) = "WRITER"
			oReplaceWord(1) = "LINE"
			oReplaceWord(2) = "PARAGRAPH"
		'
  			oReplace = oDoc.createReplaceDescriptor()
  			oReplace.SearchCaseSensitive = True
  			For n = LBound(oSearchWord()) To UBound(oReplaceWord())
    			oReplace.SearchString = oSearchWord(n)
    			oReplace.ReplaceString = oReplaceWord(n)
    			oDoc.ReplaceAll(oReplace)
  			Next n
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WSR-)[Writer]正規表現( とにかくなんでもいい１文字 )



Sub oWriterSearchRepalce
  	Dim oDoc
  	Dim oWText
  	Dim oString
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
			oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
		oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
		'
		Dim oDescriptor
		Dim oFound
		Dim oFoundAll
			oDescriptor = oDoc.createSearchDescriptor()
  			'
  			With oDescriptor
    			.SearchString = "t.s"
    			.SearchRegularExpression = true
    			.SearchCaseSensitive = False		' 大文字と小文字を区別するか?
  			End With
  			' 
  			oFoundAll = oDoc.findAll(oDescriptor)
  			for i = o to oFoundAll.getCount()-1
  				oFound = oFoundAll.getByIndex(i)
  				oDisp = "検索された文字 => " & oFound.String
  				Print oDisp
  			next i
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
Rem 「t..s」ならば「t」と「s」の間に2文字ある文字を検索
Rem 「.」自体を検索する時は「\.」

WSR-)[Writer]正規表現( 直前の文字がないか、直前の文字が１個以上連続する文字 )



Sub oWriterSearchRepalce
  	Dim oDoc
  	Dim oWText
  	Dim oString
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
			oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
		oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
		'
		Dim oDescriptor
		Dim oFound
		Dim oFoundAll
			oDescriptor = oDoc.createSearchDescriptor()
  			'
  			With oDescriptor
    			.SearchString = "to*"
    			.SearchRegularExpression = true
    			.SearchCaseSensitive = False		' 大文字と小文字を区別するか?
  			End With
  			' 
  			oFoundAll = oDoc.findAll(oDescriptor)
  			for i = o to oFoundAll.getCount()-1
  				oFound = oFoundAll.getByIndex(i)
  				oDisp = "検索された文字 => " & oFound.String
  				Print oDisp
  			next i
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WSR-)[Writer]正規表現( 直前の文字が最低でも１個ある文字 )



Sub oWriterSearchRepalce
  	Dim oDoc
  	Dim oWText
  	Dim oString
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
			oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
		oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
		'
		Dim oDescriptor
		Dim oFound
		Dim oFoundAll
			oDescriptor = oDoc.createSearchDescriptor()
  			'
  			With oDescriptor
    			.SearchString = "to+"
    			.SearchRegularExpression = true
    			.SearchCaseSensitive = False		' 大文字と小文字を区別するか?
  			End With
  			' 
  			oFoundAll = oDoc.findAll(oDescriptor)
  			for i = o to oFoundAll.getCount()-1
  				oFound = oFoundAll.getByIndex(i)
  				oDisp = "検索された文字 => " & oFound.String
  				Print oDisp
  			next i
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WSR-)[Writer]正規表現( 直前の文字が全く無いか、１つだけある )



Sub oWriterSearchRepalce
  	Dim oDoc
  	Dim oWText
  	Dim oString
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
			oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
		oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
		'
		Dim oDescriptor
		Dim oFound
		Dim oFoundAll
			oDescriptor = oDoc.createSearchDescriptor()
  			'
  			With oDescriptor
    			.SearchString = "to?"
    			.SearchRegularExpression = true
    			.SearchCaseSensitive = False		' 大文字と小文字を区別するか?
  			End With
  			' 
  			oFoundAll = oDoc.findAll(oDescriptor)
  			for i = o to oFoundAll.getCount()-1
  				oFound = oFoundAll.getByIndex(i)
  				oDisp = "検索された文字 => " & oFound.String
  				Print oDisp
  			next i
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WSR-)[Writer]正規表現( 任意の長さの文字(無くてもOK)



Sub oWriterSearchRepalce
  	Dim oDoc
  	Dim oWText
  	Dim oString
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
			oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
		oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
		'
		Dim oDescriptor
		Dim oFound
		Dim oFoundAll
			oDescriptor = oDoc.createSearchDescriptor()
  			'
  			With oDescriptor
    			.SearchString = "t.*"
    			.SearchRegularExpression = true
    			.SearchCaseSensitive = False		' 大文字と小文字を区別するか?
  			End With
  			' 
  			oFoundAll = oDoc.findAll(oDescriptor)
  			for i = o to oFoundAll.getCount()-1
  				oFound = oFoundAll.getByIndex(i)
  				oDisp = "検索された文字 => " & oFound.String
  				Print oDisp
  			next i
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WSR-)[Writer]正規表現( 複数の検索候補の文字 )



Sub oWriterSearchRepalce
  	Dim oDoc
  	Dim oWText
  	Dim oString
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
			oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
		oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
		'
		Dim oDescriptor
		Dim oFound
		Dim oFoundAll
			oDescriptor = oDoc.createSearchDescriptor()
  			'
  			With oDescriptor
    			.SearchString = "do.*nt|pa.*ph|fi.*st"
    			.SearchRegularExpression = true
    			.SearchCaseSensitive = False		' 大文字と小文字を区別するか?
  			End With
  			' 
  			oFoundAll = oDoc.findAll(oDescriptor)
  			for i = o to oFoundAll.getCount()-1
  				oFound = oFoundAll.getByIndex(i)
  				oDisp = "検索された文字 => " & oFound.String
  				Print oDisp
  			next i
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WSR-)[Writer]正規表現( どれか１つに合致する文字検索 )



Sub oWriterSearchRepalce
  	Dim oDoc
  	Dim oWText
  	Dim oString
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
			oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
		oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
		'
		Dim oDescriptor
		Dim oFound
		Dim oFoundAll
			oDescriptor = oDoc.createSearchDescriptor()
  			'
  			With oDescriptor
    			.SearchString = "[p-u]"
    			.SearchRegularExpression = true
    			.SearchCaseSensitive = False		' 大文字と小文字を区別するか?
  			End With
  			' 
  			oFoundAll = oDoc.findAll(oDescriptor)
  			for i = o to oFoundAll.getCount()-1
  				oFound = oFoundAll.getByIndex(i)
  				oDisp = "検索された文字 => " & oFound.String
  				Print oDisp
  			next i
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub
'
Rem A,B･･･Y,Zのいずれかの文字の場合は[A-Z]で検索できる。

WSR-)[Writer]正規表現( １文字ではなく、複数文字数の検索 )



Sub oWriterSearchRepalce
  	Dim oDoc
  	Dim oWText
  	Dim oString
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
			oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line." & Chr$(13) & _
						"ththththird"
		oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
		'
		Dim oDescriptor
		Dim oFound
		Dim oFoundAll
			oDescriptor = oDoc.createSearchDescriptor()
  			'
  			With oDescriptor
    			.SearchString = "(th)+..d"
    			.SearchRegularExpression = true
    			.SearchCaseSensitive = False		' 大文字と小文字を区別するか?
  			End With
  			' 
  			oFoundAll = oDoc.findAll(oDescriptor)
  			for i = o to oFoundAll.getCount()-1
  				oFound = oFoundAll.getByIndex(i)
  				oDisp = "検索された文字 => " & oFound.String
  				Print oDisp
  			next i
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WSR-)[Writer]

Table[Writer]

WT-)[Writer]表作成



Sub oWriterTable
	Dim oTable
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)  		
End Sub

WT-)[Writer]表選択1



Sub oWriterTable
	Dim oDoc
  	Dim oTable
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		' Table 選択
  		Dim oDispHelper 'Dispatch helper
  		Dim oVCursor    'The view cursor
  			oDoc.getCurrentController().select(oTable)
  			oVCursor = oDoc.getCurrentController().getViewCursor()
  			oVCursor.gotoEnd(True)
  			oVCursor.gotoEnd(True)
End Sub

WT-)[Writer]表選択2



Sub oWriterTable
	Dim oDoc
  	Dim oTable
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		' Table 選択
  		Dim oDocTable as Object
  		Dim oSelTable as Object
  		Dim oTableName as String
  			oDocTable = oDoc.TextTables
  			oSelTable = oDocTable.getByIndex(0)
  		'
  			oTableName = oSelTable.Name
  			msgbox "Table Name => " & oTableName
End Sub

WT-)[Writer]表の左右にmargin設定



Sub oWriterTable
	Dim oDoc
  	Dim oTable
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		' 表の左右にMarginを設定
  		 oTable.HoriOrient = 0 'com.sun.star.text.HoriOrientation::NONE
  			oTable.LeftMargin = 2000
  			oTable.RightMargin = 1500
  		'
  		oCurs = oDoc.getCurrentController().getViewCursor()
  		oText.insertTextContent(oCurs, oTable, False)
End Sub

WT-)[Writer]表中のCursor位置取得1



Sub oWriterTable
	Dim oVCurs    'The view cursor
	Dim oTable    'The text table that contains the text cursor.
  	Dim oCurCell  'The text table cell that contains the text cursor.
  	Dim oDoc
  	Dim Dummy()
  		oDoc=ThisComponent
		' Cursor Position
  			oVCurs = oDoc.getCurrentController().getViewCursor()
  			If IsEmpty(oVCurs.TextTable) Then
    			Print "The cursor is NOT in a table"
  			Else
    			oTable = oVCurs.TextTable
    			oCurCell = oVCurs.Cell
    			oDisp = "The cursor is in cell " & oCurCell.CellName
    		Msgbox(oDisp, 0, "Curor Position in Table")
  			End If
End Sub

WT-)[Writer]表中のCursor位置取得2



Sub oWriterTable
	Dim oDoc
  	Dim oTable
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		' Table 選択
  		Dim oVCurs  'The current view cursor.
  			oDoc.getCurrentController().select(oTable)
  			oVCurs = oDoc.getCurrentController().getViewCursor()
  		'
  		Dim oCell   'The cell that contains the cursor.
  		Dim oCol%   'The column that contains the cursor.
  		Dim oRow%   'The row that contains the cursor.
  			oCell  = oVCurs.Cell
    	'Assume less than 26 columns
    		oCol = Asc(oCell.Cellname) - 65
    		oRow = CInt(Right(oCell.Cellname, Len(oCell.Cellname) - 1)) - 1
    	' Current Cell Name
    		oTableCurrentCellName = oCell.Cellname
    			oDisp = ODisp & "The cursor is in text table : " & oTable.getName() & CHR$(10) & _
            			"The current cell is " & oTableCurrentCellName
  			MsgBox(oDisp, 0, "選択されている表中のCursorの位置")
End Sub

WT-)[Writer]表中のCursor位置取得3



Sub oWriterTable
	Dim oDoc
  	Dim oTable
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		' Table 選択
  		Dim oVCurs  'The current view cursor.
  			oDoc.getCurrentController().select(oTable)
  			oVCurs = oDoc.getCurrentController().getViewCursor()
  		'
  		Dim oCell   'The cell that contains the cursor.
  		Dim oCol%   'The column that contains the cursor.
  		Dim oRow%   'The row that contains the cursor.
  			oCell  = oVCurs.Cell
    	'Assume less than 26 columns
    		oCol = Asc(oCell.Cellname) - 65
    		oRow = CInt(Right(oCell.Cellname, Len(oCell.Cellname) - 1)) - 1
    	' Current Cell Name
    			oDisp = ODisp & "The cursor is in text table : " & oTable.getName() & CHR$(10) & _
            			"The cell is at (" & oCol & ", " & oRow & ")"
  			MsgBox(oDisp, 0, "選択されている表中のCursorの位置")
End Sub

WT-)[Writer]表中のCursor位置移動


Sub oWriterTable
	Dim oDoc
  	Dim oTable
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		' Table 選択
  		Dim oVCurs  'The current view cursor.
  			oDoc.getCurrentController().select(oTable)
  			oVCurs = oDoc.getCurrentController().getViewCursor()
  		'
  		' Cursor位置移動
  		Dim oCell   'The cell that contains the cursor.
    		oCell1 = oTable.getCellByPosition(1, 1)
    	oDoc.getCurrentController().select(oCell1)
End Sub

WT-)[Writer]表中の選択されているCell Range取得



Sub oWriterTable
	Dim oSels        'All of the selections
  	Dim oSel         'A single selection
  	Dim i As Integer
  	Dim sTextTableCursor$
  	Dim oDoc
  		sTextTableCursor$ = "com.sun.star.text.TextTableCursor"
  			oDoc = ThisComponent
  			oSels = oDoc.getCurrentController().getSelection()
  		oDisp = "選択されている表の範囲は　=> " & oSels.getRangeName()
  	msgbox( oDisp, 0, "Selection Table Range")
End Sub

WT-)[Writer]表への値入力



Sub oWriterTable
	Dim sName$
  	Dim oTable
  	Dim oAnchor
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
End Sub

WT-)[Writer]表の値取得1



Sub WriterTable()
	Dim sName$
  	Dim oTable
  	Dim oAnchor
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		' 値取得
  			Dim oData()
  				oData() = oTable.getDataArray()
  		'	
  			for i = 0 to 2
  				oDisp = oDisp & "[  " & i+1 & " 行目 ]" & Chr$(10)
  				oDisp = oDisp & Join(oData(i), CHR$(10))
  				oDisp = oDisp & Chr$(10)
  			next i
			
			Msgbox ( oDisp, 0, "表中の値取得")
End Sub

WT-)[Writer]表の値取得2



Sub oWriterTable
	Dim oDoc
	Dim oVCTable
	Dim oVC
	Dim oCell
	Dim oCol As Long
	Dim oRow As Long
		oDoc = ThisComponent
		oVC = oDoc.getCurrentController().getViewCursor()
		If IsEmpty(oVC.TextTable) Then
  			Print "The view cursor is not in a text table"
  		Exit Sub
		End If
		'oSelected = oDoc.getCurrentController().getSelection()
		oVCTable = oVC.TextTable
		oTableRow = oVCTable.getRows().getCount()
		oTableColumn = oVCTable.getColumns().getCount()
		' 
		For oRow = 0 To oTableRow - 1
  			For oCol = 0 To oTableColumn - 1
    			oCell = oVCTable.getCellByPosition(oCol, oRow)
    			oDisp = oDisp & oCell.CellName & ":" & oCell.getString() & CHR$(10)
  			Next
		Next
		Msgbox(oDisp, 0, "Tabelの値取得")
End Sub

WT-)[Writer]表の値Clear



Sub oWriterTable
	Dim sName$
  	Dim oTable
  	Dim oAnchor
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		' 値Clear
  		Dim oRange
  		Dim oData()
  		Dim oRaw()
  			oRange = oTable.getCellRangeByName("B2:C3")
  			oData() = oRange.getDataArray()
  				For i = LBound(oData()) To UBound(oData())
    				oRow() = oData(i)
    				For j = LBound(oRow()) To UBound(oRow())
      					oRow(j) = ""
    				Next j
  				Next i
  			oRange.setDataArray(oData())
End Sub

WT-)[Writer]表の名前取得



Sub oWriterTable
	Dim oTable
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
	' Get Table Name
		oTableName = oTable.getName()
	' Display
		oDisp = "Table Name : " & oTableName
		msgbox(oDisp, 0, "WriterTable")  		
End Sub

WT-)[Writer]表の名前取得2



Sub WriterTable()
	Dim oTable
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
		'
	Dim oDocTables
	Dim oTableNum
	Dim oTableName
    	oDocTables = oDoc.getTextTables()
    	oTableNum = oDocTables.getCount()
    '
     	If NOT oDocTables.hasElements() Then Exit Sub
  		For i = 0 To oDocTables.getCount() - 1
    		oTable = oDocTables.getByIndex(i)
    		oTableName = oTable.getName()
    		oDisp = oDisp & "Table Name => " & oTableName & CHR$(10)
  		Next i
  		MsgBox(oDisp, 0, "Table Name")
End Sub

WT-)[Writer]表の名前取得3



Sub oWriterTable
	Dim oTable
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
		'
	Dim oDocTables
	Dim oTableNum
    	oDocTables = oDoc.getTextTables()
    	oTableNum = oDocTables.getCount()
    '
     	If NOT oDocTables.hasElements() Then Exit Sub
  		oDisp = Join(oDocTables.getElementNames(), CHR$(10))
  		MsgBox(oDisp, 0, "Table Name")		
End Sub

WT-)[Writer]表の行列数取得1



Sub oWriterTable
	Dim oDoc
	Dim oVCTable
	Dim oVC
	Dim oCell
	Dim oCol As Long
	Dim oRow As Long
		oDoc = ThisComponent
		oVC = oDoc.getCurrentController().getViewCursor()
		If IsEmpty(oVC.TextTable) Then
  			Print "The view cursor is not in a text table"
  		Exit Sub
		End If
		'oSelected = oDoc.getCurrentController().getSelection()
		oVCTable = oVC.TextTable
		oTableRow = oVCTable.getRows().getCount()
		oTableColumn = oVCTable.getColumns().getCount()
		oDisp =  "Rows    = " & oTableRow & Chr$(10) & _
					"Column = " & oTableColumn
		'
		Msgbox(oDisp, 0, "行列数取得 in Writer Table")
End Sub

WT-)[Writer]表の行列数取得2



Sub oWriterTable
	Dim oDoc
  	Dim oTable
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		' Table 選択
  		Dim oVCurs  'The current view cursor.
  			oDoc.getCurrentController().select(oTable)
  			oVCurs = oDoc.getCurrentController().getViewCursor()
  		'
  		Dim oCell   'The cell that contains the cursor.
  		Dim oCol%   'The column that contains the cursor.
  		Dim oRow%   'The row that contains the cursor.
  			oCell  = oVCurs.Cell
    	'Assume less than 26 columns
    		oCol = Asc(oCell.Cellname) - 65
    		oRow = CInt(Right(oCell.Cellname, Len(oCell.Cellname) - 1)) - 1
    	' 
    		oDisp = ODisp & "The cursor is in text table : " & oTable.getName() & CHR$(10) & _
            			CHR$(10) & "The table has " & oTable.getColumns().getCount() & _
            			" columns and " & oTable.getRows().getCount() & " Rows" & CHR$(10)
  			MsgBox(oDisp, 0, "表の行列数取得")
End Sub

WT-)[Writer]表の削除1



Sub oWriterTable
	Dim oTable
	Dim oTableName
	Dim oWriterTable
	Dim oAnchor
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
	' Get Table Name
		oTableName = oTable.getName()
	'　TableのAnchor取得
		oWTable = oDoc.getTextTables().getByName(oTableName)
  		oAnchor = oWTable.getAnchor()
  '　Documentの最初にCursorを移動
  		oCurs = oDoc.getCurrentController().getViewCursor()
  		oCurs.gotoStart(False)
  ' I would Love to be able to move the cursor to the anchor, but I can not create a crusor based on the anchor, move to
  ' the anchor, etc. So, I use a trick and let the controller move the view cursor to the table.
  ' Unfortunately, you can not move the cursor to the anchor...
  '　Tableの選択
  		oDoc.getCurrentController().select(oTable)
  ' Table 削除		
  		oTable.dispose()	
End Sub

WT-)[Writer]表の削除2



Sub oWriterTable
	Dim oText as Object
	Dim oTable as Object
	Dim oTableName as String
	Dim oWriterTable as Object
	Dim oAnchor as Object
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oText = oDoc.getText()
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oText.insertTextContent(oDoc.Text.getEnd(), oTable, false)
	' Get Table Name
		oTableName = oTable.getName()
	'　TableのAnchor取得
		oWTable = oDoc.getTextTables().getByName(oTableName)
  ' Table 削除		
  		oText.removeTextContent(oWTable)
  		'
  		msgbox "Success"
End Sub

WT-)[Writer]表中の2列目にCuror移動


Sub oWriterTable
	Dim oDoc
  	Dim oTable
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		' Table 選択
  		Dim oVCurs  'The current view cursor.
  			oDoc.getCurrentController().select(oTable)
  			oVCurs = oDoc.getCurrentController().getViewCursor()
  		'
  		' 2列目にCursor移動
  		oVCurs.goDown(1,False) 
End Sub

WT-)[Writer]表の前にCuror移動



Sub oWriterTable
	Dim oText as Object
	Dim oTable
	Dim oWTable
	Dim oCurs
	Dim oDoc
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oText = oDoc.getText()
		oSText = "[ Writer Table ] " & Chr$(13)
			oText.insertString(oText.getStart(), oSText , false)		'文頭
		' Create Table
			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
			oTable.initialize(3, 5) 			' 3 rows,  5 columns
			oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
			oTableName = oTable.getName()
		'	
			oWTable = oDoc.getTextTables().getByName(oTableName)
		'Move the cursor to the first row and column
  			oDoc.getCurrentController().select(oWTable)
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oCurs.goLeft(1, False)  	
End Sub

WT-)[Writer]表の前にParagraph挿入



Sub WriterTable()
	Dim oText as Object
	Dim oTable
	Dim oWTable
	Dim oCurs
	Dim oDoc
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oText = oDoc.getText()
		oSText = "[ Writer Table ] " & Chr$(13)
			oText.insertString(oText.getStart(), oSText , false)		'文頭
		' Create Table
			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
			oTable.initialize(3, 5) 			' 3 rows,  5 columns
			oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
				'	oTableName = oTable.getName()
		'	
			oWTable = oDoc.getTextTables().getByIndex(0)
		' Insert Paragraph
		  	oCurs = oText.createTextCursor()
  			oPar = oDoc.createInstance("com.sun.star.text.Paragraph")
  			oText.insertTextContentBefore ( oPar, oWTable )
End Sub

WT-)[Writer]Document中の表数取得



Sub WriterTable()
	Dim oTable
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oDoc.Text.insertTextContent(oDoc.Text.getEnd(), oTable, false)
		'
	Dim oDocTables
	Dim oTableNum
    	oDocTables = oDoc.getTextTables()
    	oTableNum = oDocTables.getCount()
  		oDisp = "This document contains " & oTableNum & " tables"
  		'
  		msgbox(oDisp, 0, "Table数取得")  		
End Sub

WT-)[Writer]外枠線を消す



Sub WriterTable()
	Dim oDoc
	Dim oText
	Dim oTable
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'
		oText = oDoc.getText()
			oDisp = "FirstLine" & Chr$(10)
		oText.insertString(oText.getEnd(), oDisp, false)
		'
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oText.insertTextContent(oText.getEnd(), oTable, false)
		'
	Dim v
  	Dim x
  		v = oTable.TableBorder
  			x = v.TopLine        : x.OuterLineWidth = 0 : v.TopLine        = x
  			x = v.LeftLine       : x.OuterLineWidth = 0 : v.LeftLine       = x
  			x = v.RightLine      : x.OuterLineWidth = 0 : v.RightLine      = x
  			x = v.BottomLine     : x.OuterLineWidth = 0 : v.BottomLine     = x
  		oTable.TableBorder = v	
End Sub

WT-)[Writer]外枠線を極太線にする



Sub WriterTable()
	Dim oDoc
	Dim oText
	Dim oTable
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'
		oText = oDoc.getText()
			oDisp = "FirstLine" & Chr$(10)
		oText.insertString(oText.getEnd(), oDisp, false)
		'
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oText.insertTextContent(oText.getEnd(), oTable, false)
		'
	Dim v
  	Dim x
  		v = oTable.TableBorder
  			x = v.TopLine        : x.OuterLineWidth = 200 : v.TopLine        = x			' 200 => 5pt
  			x = v.LeftLine       : x.OuterLineWidth = 200 : v.LeftLine       = x
  			x = v.RightLine      : x.OuterLineWidth = 200 : v.RightLine      = x
  			x = v.BottomLine     : x.OuterLineWidth = 200 : v.BottomLine     = x
  		oTable.TableBorder = v	
End Sub

WT-)[Writer]内枠線を消す



Sub WriterTable()
	Dim oDoc
	Dim oText
	Dim oTable
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'
		oText = oDoc.getText()
			oDisp = "FirstLine" & Chr$(10)
		oText.insertString(oText.getEnd(), oDisp, false)
		'
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oText.insertTextContent(oText.getEnd(), oTable, false)
		'
	Dim v
  	Dim x
  		v = oTable.TableBorder
  			x = v.VerticalLine   : x.OuterLineWidth = 0 : v.VerticalLine   = x
  			x = v.HorizontalLine : x.OuterLineWidth = 0 : v.HorizontalLine = x
  		oTable.TableBorder = v	
End Sub

WT-)[Writer]内枠線を極太線にする



Sub WriterTable()
	Dim oDoc
	Dim oText
	Dim oTable
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'
		oText = oDoc.getText()
			oDisp = "FirstLine" & Chr$(10)
		oText.insertString(oText.getEnd(), oDisp, false)
		'
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oText.insertTextContent(oText.getEnd(), oTable, false)
		'
	Dim v
  	Dim x
  		v = oTable.TableBorder
  			x = v.VerticalLine   : x.OuterLineWidth = 200 : v.VerticalLine   = x			' 200 => 5pt
  			x = v.HorizontalLine : x.OuterLineWidth = 200 : v.HorizontalLine = x
  		oTable.TableBorder = v	
End Sub

WT-)[Writer]線の色設定



Sub WriterTable()
	Dim oDoc
	Dim oText
	Dim oTable
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'
		oText = oDoc.getText()
			oDisp = "FirstLine" & Chr$(10)
		oText.insertString(oText.getEnd(), oDisp, false)
		'
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oText.insertTextContent(oText.getEnd(), oTable, false)
		'
	Dim v
  	Dim x
  		v = oTable.TableBorder
  			x = v.TopLine        : x.OuterLineWidth = 2 	:	x.Color = RGB(255, 0, 0) 	: v.TopLine        = x			' 2 => 0.05pt
  			x = v.LeftLine       : x.OuterLineWidth = 2 	:	x.Color = RGB(255, 0, 0)	: v.LeftLine       = x
  			x = v.RightLine      : x.OuterLineWidth = 2 	:	x.Color = RGB(255, 0, 0)	: v.RightLine      = x
  			x = v.VerticalLine   : x.OuterLineWidth = 2 : v.VerticalLine   = x			' 2 => 0.05pt
  			x = v.HorizontalLine : x.OuterLineWidth = 2 : v.HorizontalLine = x
  			x = v.BottomLine     : x.OuterLineWidth = 2 	:	x.Color = RGB(255, 0, 0)		: v.BottomLine     = x
  		oTable.TableBorder = v
End Sub

WT-)[Writer]Cellの背景設定



Sub WriterTable()
	Dim oDoc
	Dim oText
	Dim oTable
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'
		oText = oDoc.getText()
			oDisp = "FirstLine" & Chr$(10)
		oText.insertString(oText.getEnd(), oDisp, false)
		'
		oTable = oDoc.createInstance("com.sun.star.text.TextTable")
		oTable.initialize(3, 5) 			' 3 rows,  5 columns
		oText.insertTextContent(oText.getEnd(), oTable, false)
		'
	Dim v
  	Dim x
  		v = oTable.TableBorder
  			x = v.TopLine        : x.OuterLineWidth = 2 : v.TopLine        = x			' 2 => 0.05pt
  			x = v.LeftLine       : x.OuterLineWidth = 2 : v.LeftLine       = x
  			x = v.RightLine      : x.OuterLineWidth = 2 : v.RightLine      = x
  			x = v.VerticalLine   : x.OuterLineWidth = 2 : v.VerticalLine   = x			' 2 => 0.05pt
  			x = v.HorizontalLine : x.OuterLineWidth = 2 : v.HorizontalLine = x
  			x = v.BottomLine     : x.OuterLineWidth = 2 : v.BottomLine     = x
  		oTable.TableBorder = v
  '
  	Dim oCell
  	Dim oRow As Long
  	Dim oCol As Long
  		For oRow = 0 To oTable.getRows().getCount() - 1
    		For oCol = 0 To oTable.getColumns().getCount() - 1
      			oCell = oTable.getCellByPosition(oCol, oRow)
      			If oRow = 0 Then
        			oCell.BackColor = 128
      			Else
      				If oRow MOD 2 = 1 Then
          				oCell.BackColor = -1
        			Else
          			' color is (230, 230, 230)
          				oCell.BackColor = 15132390
  					End If
  				End If
   			Next
  		Next	
End Sub

WT-)[Writer]Cell幅変更



Sub WriterTable()
	Dim sName$
  	Dim oTable
  	Dim oAnchor
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		' 
  		Dim oTblColSeps  'The array of table column separators.
  			oTblColSeps = oTable.TableColumnSeparators
  		'Change the positions
  			oTblColSeps(0).Position = 500		' 0 => 左側から1番目の内枠縦線
			oTblColSeps(1).Position = 1500		' 1 => 左側から2番目の内枠縦線
  		'To be assigned the array back
  			oTable.TableColumnSeparators = oTblColSeps
End Sub

WT-)[Writer]Cell幅変更2



Sub WriterTable()
	Dim sName$
  	Dim oTable
  	Dim oAnchor
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		' Table Width　変更
  		Dim oDispHelper 'Dispatch helper
  		Dim oFrame      'Current window frame.
  		Dim oVCursor    'The view cursor
  			oDoc.getCurrentController().select(oTable)
  			oVCursor = oDoc.getCurrentController().getViewCursor()
  			oVCursor.gotoEnd(True)
  			oVCursor.gotoEnd(True)
  		'
  			oFrame = oDoc.CurrentController.Frame
  			oDispHelper = createUnoService("com.sun.star.frame.DispatchHelper")
  		oDispHelper.executeDispatch(oFrame, ".uno:SetOptimalColumnWidth", "", 0, Array())
End Sub

WT-)[Writer]autoFormat1



Sub WriterTable()
	Dim oDoc
  	Dim oTable
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		' autoFormat
  			oTable.autoFormat("3D")
  		' Display
  			msgbox "Success"
End Sub
'
' [ Format Name ]
' FormatNameは以下の様な値があるが、3D以外は設定されない。
' 3D
' Black 1 
' Black 2
' Blue
' Brown
' Currency
' Currency 3D
' Currency Lavender
' Currency Turquoise
' Gray
' Green
' 参考uRL : http://wiki.services.openoffice.org/wiki/Documentation/OOo3_User_Guides/Calc_Guide/Autoformat_and_themes

WT-)[Writer]各Cellの値を残してCell結合


Sub WriterTable()
	Dim oDoc
  	Dim oTable
  	Dim oCurs
  	Dim oText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  			oText = oDoc.getText()
  		' Create Table	
  			oTable = oDoc.createInstance("com.sun.star.text.TextTable")
  			oTable.initialize(3, 3)
  		'　入力範囲設定
  			oCurs = oDoc.getCurrentController().getViewCursor()
  			oText.insertTextContent(oCurs, oTable, False)
  		' 入力	
  			oTable.setDataArray(Array(Array(1,2,3), Array(4,5,6), Array(7,8,9))
  		'
  		 ' Cursor位置移動
  		 Dim oTableCur as Object
  		 	' Cursor位置をB2へ
  			oTableCur =oTable.createCursorByCellName("B2")
  			' 範囲指定（右に1セル、下に1セル)
  			oTableCur.goRight(1,True)
			oTableCur.goDown(1,True)
			' Merge
			oTableCur.mergeRange()
  		'
  		msgbox "Success"
End Sub

WT-)[Writer]

Style

WSt-)[Writer]Capter Style取得



Sub oCNumberRule
	Dim i%
  	Dim oRules
  	Dim oRule()
  	Dim oProp
  		On Error Resume Next
  		oDoc = ThisComponent
		'
  		oRules = oDoc.getChapterNumberingRules()
  			oRuleCount = oRules.getCount()
  		'
  			For i = 0 To oRuleCount - 1
    			oRule() = oRules.getByIndex(i)
      				oProp = oRule(i)
      				oPName = oProp.Name
      					oDisp = oDisp & i & ")" & oPName
      					oDisp = oDisp & " => " & oProp.Value
      					oDisp = oDisp & Chr$(10)
  			Next i
  		msgbox( oDisp, 0, "ChapterNumberingRules")
End Sub

WSt-)[Writer]2列書き



Sub oAddTextSection
  	Dim oDoc
  	Dim Dummy()
  	Dim oSect
  	Dim oName$
  	Dim oVC
  	Dim oText
  	Dim oCols
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'
    	oVC = oDoc.getCurrentController().getViewCursor()
    	oText = oVC.getText()
        oDisp = "This is One Column."
        oText.insertString(oText.getEnd(), oDisp, false)
        '
        oText.insertControlCharacter(oVC, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
        oText.insertControlCharacter(oVC, com.sun.star.text.ControlCharacter.LINE_BREAK, True)
    	'
    	oSect = oDoc.createInstance("com.sun.star.text.TextSection")
    	oName = "CreateSectionInWriter"
    	oSect.setName(oName)
    	'.
    	oCols = oDoc.createInstance("com.sun.star.text.TextColumns")
    	oCols.setColumnCount(2)
    	oSect.TextColumns = oCols
    	oText.insertTextContent(oVC, oSect, True)
    	'
    	oDisp = "This is new text. " & _
        "I suppose that I could count and repeat myself as " & _
        "an example of how text can go on and on and on. " & _
        "I suppose that I could count and repeat myself as " & _
        "an example of how text can go on and on and on. " & _
        "I suppose that I could count and repeat myself as " & _
        "an example of how text can go on and on and on. " & _
        "I suppose that I could count and repeat myself as " & _
        "an example of how text can go on and on and on. " & _
        "I suppose that I could count and repeat myself as " & _
        "an example of how text can go on and on and on. " & _
        "I suppose that I could count and repeat myself as " & _
        "an example of how text can go on and on and on. " & _
        "And finally I will stop."
    	oText.insertString(oVC, oDisp, True)
    	'
  		oCols = oSect.TextColumns
  	Dim oOC()
  		oOC() = oCols.getColumns()
		'
  		oOC(0).RightMargin = 500		' Unit : 1/100mm
  		oOC(1).LeftMargin = 500		' Unit : 1/100mm
  		'
  		oCols.setColumns(oOC())
  		oSect.TextColumns = oCols
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WSt-)[Writer]Section数取得



Sub oAddTextSection
  	Dim oDoc
  	Dim Dummy()
  	Dim oSect
  	Dim oName$
  	Dim oVC
  	Dim oText
  	Dim oCols
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'
    	oVC = oDoc.getCurrentController().getViewCursor()
    	oText = oVC.getText()
        oDisp = "This is One Column."
        oText.insertString(oText.getEnd(), oDisp, false)
        '
        oText.insertControlCharacter(oVC, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
        oText.insertControlCharacter(oVC, com.sun.star.text.ControlCharacter.LINE_BREAK, True)
    	'
    	oSect = oDoc.createInstance("com.sun.star.text.TextSection")
    	oName = "CreateSectionInWriter"
    	oSect.setName(oName)
    	'.
    	oCols = oDoc.createInstance("com.sun.star.text.TextColumns")
    	oCols.setColumnCount(2)
    	oSect.TextColumns = oCols
    	oText.insertTextContent(oVC, oSect, True)
    	'
    	oDisp = "This is new text. " & _
        "I suppose that I could count and repeat myself as " & _
        "an example of how text can go on and on and on. " & _
        "I suppose that I could count and repeat myself as " & _
        "an example of how text can go on and on and on. " & _
        "I suppose that I could count and repeat myself as " & _
        "an example of how text can go on and on and on. " & _
        "I suppose that I could count and repeat myself as " & _
        "an example of how text can go on and on and on. " & _
        "I suppose that I could count and repeat myself as " & _
        "an example of how text can go on and on and on. " & _
        "I suppose that I could count and repeat myself as " & _
        "an example of how text can go on and on and on. " & _
        "And finally I will stop."
    	oText.insertString(oVC, oDisp, True)
    	'
  		oCols = oSect.TextColumns
  	Dim oOC()
  		oOC() = oCols.getColumns()
		'
  		oOC(0).RightMargin = 500		' Unit : 1/100mm
  		oOC(1).LeftMargin = 500		' Unit : 1/100mm
  		'
  		oCols.setColumns(oOC())
  		oSect.TextColumns = oCols
  		'
  		oSectionNum = oDoc.getTextSections().getCount() + 1
  		oDisp = "Section数は" & Chr$(10) & "  " & oSectionNum
  		msgbox(oDisp, 0, "Section数") 
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

[ CharacterStyles ]

WStS-)[Writer]Style Name取得



Sub oWriterStyle
  	Dim oDoc
  	Dim oText
  	Dim oCur
  	Dim oObj
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'Get the StyleFamilies
			Dim oFamilies
			Dim oFamilyNames
			Dim oStyleName
				oFamilies = oDoc.StyleFamilies
				oFamilyNames = oFamilies.getElementNames()
				oStyleName = oFamilies.getByName("CharacterStyles") 
				oSElementName = oStyleName.ElementNames
				oDisp = ""
			'Get the Style Name
				for i = LBound(oSElementName) to UBound(oSElementName)
					oDisp = oDisp & i & ")" & oSElementName(i)
					oDisp = oDisp & Chr$(10)
				next i
			msgbox(oDisp, 0, "Style Name")
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WStS-)[Writer]CharacterStyle変更



Sub oWriterStyle
  	Dim oDoc
  	Dim oSelections
  	Dim oSel
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oSelections = oDoc.getCurrentSelection()
    	oSel = oSelections.getByIndex(0)
    	' 変更前のStyle Name取得
    		oStyleName1 = oSel.CharStyleName
    			oDisp = "変更前のStyle Name :" & oStyleName1
    			oDisp = oDisp & Chr$(10) & Chr$(10)
    	' Style Nameの変更
    		oSel.CharStyleName = "Numbering Symbols"
    	'
    	oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
				oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
    	' Confirm
    		oStyleName2 = oSel.CharStyleName
    			oDisp = oDisp & "変更後のStyle Name :" & oStyleName2
			msgbox(oDisp, 0, "Style変更")
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

[ ParagraphStyles ]

WStP-)[Writer]Style Name取得



Sub oWriterStyle
  	Dim oDoc
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'Get the StyleFamilies
			Dim oFamilies
			Dim oFamilyNames
			Dim oStyleName
				oFamilies = oDoc.StyleFamilies
				oFamilyNames = oFamilies.getElementNames()
				oStyleName = oFamilies.getByName("ParagraphStyles") 
				oSElementName = oStyleName.ElementNames
				oDisp = ""
			'Get the Style Name
				for i = LBound(oSElementName) to UBound(oSElementName)
					oDisp = oDisp & i & ")" & oSElementName(i)
					oDisp = oDisp & Chr$(10)
				next i
			msgbox(oDisp, 0, "Style Name")
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WStP-)[Writer]ParagraphStyle変更



Sub oWriterStyle
  	Dim oDoc
  	Dim oSelections
  	Dim oSel
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oSelections = oDoc.getCurrentSelection()
    	oSel = oSelections.getByIndex(0)
    	' 変更前のStyle Name取得
    		oStyleName1 = oSel.ParaStyleName
    			oDisp = "変更前のStyle Name :" & oStyleName1
    			oDisp = oDisp & Chr$(10) & Chr$(10)
    	' Style Nameの変更
    		oSel.ParaStyleName = "Heading 2"
    	' Confirm
    		oStyleName2 = oSel.ParaStyleName
    			oDisp = oDisp & "変更後のStyle Name :" & oStyleName2
			msgbox(oDisp, 0, "Style変更")
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

[ Tab Stop ]

WStTb-)[Writer]Tab Stop1



Sub oTabStop
	Dim oDoc as Object
	Dim oText as Object
	Dim oDisp as String
	Dim oStyleFamily as Object
	Dim oParentStyleName as String
	Dim oStyleName as String
		oDoc = ThisComponent
		'
		
		oStyle = oDoc.createInstance( "com.sun.star.style.ParagraphStyle" )
		'
		oStyleName = "oTabStopStyle"
		oParentStyleName = "oHeading"
		If IsMissing( oParentStyleName ) Then 
      		oParentStyleName = "" 
   		End If
   		'
   		oStyleFamily = oDoc.getStyleFamilies().getByName( "ParagraphStyles" ) 
   		'
		' Does the style already exist? 
   		If oStyleFamily.hasByName( oStyleName ) Then 
      		' Then get it so we can return it. 
      		oStyle = oStyleFamily.getByName( oStyleName ) 
   		Else 
      		' Create new style object. 
      		oStyle = oDoc.createInstance( "com.sun.star.style.ParagraphStyle" ) 
       		'
      		' Set its parent style, if one is specified. 
      		If Not IsMissing( oParentStyleName )  And  Len( oParentStyleName ) > 0 Then 
         		oStyle.setParentStyle( oParentStyleName ) 
      		End If 
       		'
      		' Add the new style to the style family. 
      		oStyleFamily.insertByName( oStyleName, oStyle ) 
   		End If
		'
		oStyle.ParaTabStops =Array(MakeTabStop(80000),MakeTabStop(40000))
		'
		oText = oDoc.getText()
		oDisp = Chr$(9) & "Tab11" & Chr$(9) & "Tab12" & Chr$(9) & "Tab13" & Chr$(10) & _
					Chr$(9) & "Tab21" & Chr$(9) & "Tab22" & Chr$(9) & "Tab23" & Chr$(13) & _
					Chr$(9) & "Tab31" & Chr$(9) & "Tab32" & Chr$(9) & "Tab33" 
		oText.insertString(oText.getEnd(), oDisp, false)
End Sub
'
Function MakeTabStop( ByVal nPosition As Long) As com.sun.star.style.TabStop
	Dim oTabStop as Object
   	oTabStop = createUnoStruct( "com.sun.star.style.TabStop" ) 
    '
    ' Tab Stop位置
   	oTabStop.Position = nPosition			' 1/1000cm
   	'
   	' Tab Stopに対する文の位置
   	oTabStop.Alignment = com.sun.star.style.TabAlign.LEFT
   	'
   	'Tabを表示する文字
     oTabStop.FillChar = ASC("･")
	'
   	MakeTabStop() = oTabStop 
End Function
'
' [ Alignment ]
'	com.sun.star.style.TabAlign.LEFT = 0 
'   com.sun.star.style.TabAlign.CENTER = 1 
'   om.sun.star.style.TabAlign.RIGHT = 2 
'   com.sun.star.style.TabAlign.DECIMAL = 3 
'   com.sun.star.style.TabAlign.DEFAULT = 4

WStTb-)[Writer]Tab Stop2



Sub oTabStop
	Dim oDoc as Object
	Dim oText as Object
	Dim oDisp as String
	Dim viewCursor as Object
	Dim oCursor as Object
		oDoc = ThisComponent
		'
		viewCursor = oDoc.currentController.getViewCursor()
    	oCursor = oDoc.Text.createTextCursorByRange(viewCursor.getStart())
    	'
    	oCursor.ParaTabStops = Array(MakeTabStop(5000))
		'
		oText = oDoc.getText()
		oDisp = Chr$(9) & "Tab11" & Chr$(9) & "Tab12" & Chr$(9) & "Tab13" & Chr$(10) & _
					Chr$(9) & "Tab21" & Chr$(9) & "Tab22" & Chr$(9) & "Tab23" & Chr$(13) & _
					Chr$(9) & "Tab31" & Chr$(9) & "Tab32" & Chr$(9) & "Tab33" 
		oText.insertString(oText.getEnd(), oDisp, false)	
End Sub
'
Function MakeTabStop( ByVal nPosition As Long) As com.sun.star.style.TabStop
	Dim oTabStop as Object
   	oTabStop = createUnoStruct( "com.sun.star.style.TabStop" ) 
    '
    ' Tab Stop位置
   	oTabStop.Position = nPosition			' 1/1000cm
   	'
   	' Tab Stopに対する文の位置
   	oTabStop.Alignment = com.sun.star.style.TabAlign.LEFT
   	'
   	' Tabの代わりに表示する文字 
     oTabStop.FillChar = Asc("･")
	'
   	MakeTabStop() = oTabStop 
End Function
'
' [ Alignment ]
'	com.sun.star.style.TabAlign.LEFT = 0 
'   com.sun.star.style.TabAlign.CENTER = 1 
'   om.sun.star.style.TabAlign.RIGHT = 2 
'   com.sun.star.style.TabAlign.DECIMAL = 3 
'   com.sun.star.style.TabAlign.DEFAULT = 4

[ PageStyles ]

WStPg-)[Writer]Style Name取得



Sub oWriterStyle
  	Dim oDoc
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'Get the StyleFamilies
			Dim oFamilies
			Dim oFamilyNames
			Dim oStyleName
				oFamilies = oDoc.StyleFamilies
				oFamilyNames = oFamilies.getElementNames()
				oStyleName = oFamilies.getByName("PageStyles") 
				oSElementName = oStyleName.ElementNames
				oDisp = ""
			'Get the Style Name
				for i = LBound(oSElementName) to UBound(oSElementName)
					oDisp = oDisp & i & ")" & oSElementName(i)
					oDisp = oDisp & Chr$(10)
				next i
			msgbox(oDisp, 0, "Style Name")
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WStPg-)[Writer](未完成)PageStylesStyle変更


Sub oWriterStyle
  	Dim oDoc
  	Dim oSelections
  	Dim oSel
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oSelections = oDoc.getCurrentSelection()
    	oSel = oSelections.getByIndex(0)
    	' 変更前のStyle Name取得
    		oStyleName1 = oSel.PageStyleName
    			oDisp = "変更前のStyle Name :" & oStyleName1
    			oDisp = oDisp & Chr$(10) & Chr$(10)
    	' Style Nameの変更
    		oSel.PageStyleName = "Footnote"
    	'
    	oString = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						Chr$(9) & "This line is first paragraph too. But it is second line." & Chr$(13) & _
						Chr$(9) & Chr$(9) & "This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
				oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oString, false)
    	' Confirm
    		oStyleName2 = oSel.PageStyleName
    			oDisp = oDisp & "変更後のStyle Name :" & oStyleName2
			msgbox(oDisp, 0, "Style変更")
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

[ NumberingStyles ]

WStNum-)[Writer]Style Name取得



Sub oWriterStyle
  	Dim oDoc
  	Dim Dummy()
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'Get the StyleFamilies
			Dim oFamilies
			Dim oFamilyNames
			Dim oStyleName
				oFamilies = oDoc.StyleFamilies
				oFamilyNames = oFamilies.getElementNames()
				oStyleName = oFamilies.getByName("NumberingStyles") 
				oSElementName = oStyleName.ElementNames
				oDisp = ""
			'Get the Style Name
				for i = LBound(oSElementName) to UBound(oSElementName)
					oDisp = oDisp & i & ")" & oSElementName(i)
					oDisp = oDisp & Chr$(10)
				next i
			msgbox(oDisp, 0, "Style Name")
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

WStNum-)[Writer](未完成)NumberingStylesStyle変更

HyperLink[Writer]

[ BookMark ]

WHB-)[Writer]Bookmark設定



Sub oWriterBkMk
	Dim oDoc
	Dim oBookMark
	Dim oCurs
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		' Insert Text
			oText = oDoc.getText()
				oString = "Openoffice.org Basic Macro for BookMark" & Chr$(13) & "Here"
				oText.insertString(oText.getEnd(), oString, false)		'文末
		'
			oCurs = oDoc.Text.createTextCursor()
			oCurs.gotoEnd(False)
			oCurs.goLeft(4,True)
		'
			oBookMark = oDoc.createInstance("com.sun.star.text.Bookmark")
			oBookMark.setName("macro")
			oText.insertTextContent(oCurs, oBookMark, False)
End Sub

WHB-)[Writer]bookmark anchorのSelect



Sub oWriterBkMk
	Dim oAnchor  'Bookmark anchor
	Dim oCursor  'Cursor at the left most range.
  	Dim oMarks
  	Dim oCurs
	Dim oDoc
	Dim oBookMark
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		' Insert Text
			oText = oDoc.getText()
				oString = "Openoffice.org Basic Macro for BookMark" & Chr$(13) & "Here"
				oText.insertString(oText.getEnd(), oString, false)		'文末
		'
			oCurs = oDoc.Text.createTextCursor()
			oCurs.gotoEnd(False)
			oCurs.goLeft(4,True)
		'
			oBookMark = oDoc.createInstance("com.sun.star.text.Bookmark")
			oBookMark.setName("macro")
			oText.insertTextContent(oCurs, oBookMark, False)
		'
			oMarks = oDoc.getBookmarks()
  			oAnchor = oMarks.getByName("macro").getAnchor()
  			oCursor = oDoc.getCurrentController().getViewCursor()
  			oCursor.gotoRange(oAnchor, False)
End Sub

WHB-)[Writer]Bookmark AnchorとCurosrの位置関係取得



Sub oWriterBkMk
	Dim oAnchor  'Bookmark anchor
	Dim oCursor  'Cursor at the left most range.
  	Dim oMarks
  	Dim oCurs
	Dim oDoc
	Dim oBookMark
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		' Insert Text
			oText = oDoc.getText()
				oString = "Openoffice.org Basic Macro for BookMark" & Chr$(13) & "Here"
				oText.insertString(oText.getEnd(), oString, false)		'文末
		'
			oCurs = oDoc.Text.createTextCursor()
			oCurs.gotoEnd(False)
			oCurs.goLeft(4,True)
		'
			oBookMark = oDoc.createInstance("com.sun.star.text.Bookmark")
			oBookMark.setName("macro")
			oText.insertTextContent(oCurs, oBookMark, False)
		'
			oMarks = oDoc.getBookmarks()
  			oAnchor = oMarks.getByName("macro").getAnchor()
  			oCursor = oDoc.getCurrentController().getViewCursor()
  			oCursor.gotoRange(oAnchor, False)
  		'
  			If NOT EqualUNOObjects(oCursor.getText(), oAnchor.getText()) Then
    			Print "The view cursor and the anchor use a different text object"
    			Exit Sub
  			End If
  	'
  		Dim oCursText, oEnd1, oEnd2
  			oDisp = "[ Bookmark AnchorとCurosrの関係 ]" & Chr$(10)
  			oCursText = oCursor.getText()
  				oEnd1 = oCursor.getEnd()
  				oEnd2 = oAnchor.getEnd()
  			If oCursText.compareRegionStarts(oEnd1, oEnd2) >= 0 Then
    			oDisp =  oDisp & "Cursor END is Left of the anchor end"
  			Else
    			oDisp = oDisp & "Cursor END is Right of the anchor end"
  			End If
  		' Display
  			msgbox(oDisp , 0 , "Writer Bookmark")
End Sub

WHB-)[Writer]Insert text at a bookmark



Sub oWriterBkMk
	Dim oAnchor  'Bookmark anchor
	Dim oCursor  'Cursor at the left most range.
  	Dim oMarks
  	Dim oCurs
	Dim oDoc
	Dim oBookMark
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		' Insert Text
			oText = oDoc.getText()
				oString = "Openoffice.org Basic Macro for BookMark" & Chr$(13) & "Here"
				oText.insertString(oText.getEnd(), oString, false)		'文末
		'
			oCurs = oDoc.Text.createTextCursor()
			oCurs.gotoEnd(False)
			oCurs.goLeft(4,True)
		'
			oBookMark = oDoc.createInstance("com.sun.star.text.Bookmark")
			oBookMark.setName("macro")
			oText.insertTextContent(oCurs, oBookMark, False)
		'
			oMarks = oDoc.getBookmarks()
  			oAnchor = oMarks.getByName("macro").getAnchor()
  			oCursor = oDoc.getCurrentController().getViewCursor()
  			oCursor.gotoRange(oAnchor, False)
  		'
  			oBookMark1 = oDoc.getBookmarks().getByName("macro")
  				oString1 = " Insert Text At Bookmark"
			oBookMark1.getAnchor.setString(oString1)
End Sub

[ Index ]

WHI-)[Writer]Index作成



Sub oDocument
	Dim oDoc
	Dim oText
	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oText = oDoc.getText()
		'
	Dim oIndex
	Dim oCurs
		oIndex = oDoc.createInstance("com.sun.star.text.ContentIndex")
    	'
    	oIndex.CreateFromOutline = True
		'
    	oCurs = oText.createTextCursor()
    	oCurs.gotoStart(False)
    	oText.insertTextContent(oCurs, oIndex, False)
  	'	
  	oIndex.update()
End Sub

WHI-)[Writer]O

[ HyperLink ]

WHH-)[Writer]HyperLink設定



Sub WriterHyperLink()
  	Dim oDoc
  	Dim oText    'Text object for the current object
  	Dim oVCursor 'Current view cursor
  	Dim Dummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		'
  		oVCursor = oDoc.getCurrentController().getViewCursor()
  		oText = oVCursor.getText()
  		oText.insertString(oVCursor, "OpenOffice.org Community", True)
  		'
  		oVCursor.HyperLinkURL = "http://www.openoffice.org/"
End Sub

WHH-)[Writer]

Outline

WOt-)[Writer]Outline設定1



Sub WriterOutline()
	Dim oDoc as Object
	Dim Dummy()
	Dim document   as Object
	Dim dispatcher as Object
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
	' Dispatcher
		document   = oDoc.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	Dim oArgs1(0) as new com.sun.star.beans.PropertyValue
		for i = 1 to 9
			oArgs1(0).Name = "NumRule"
			oArgs1(0).Value = "List " & i
			dispatcher.executeDispatch(document, ".uno:NumRule", "", 0, args1())
		'
			oOutlineText = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						"This line is first paragraph too. But it is second line." & Chr$(13) & _
						"This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line."
				oWText = oDoc.getText()
			oWText.insertString(oWText.getEnd(), oOutlineText, false)
		next i
End Sub

WOt-)[Writer]Outline設定2a



Sub WriterOutline()
	Dim oDoc as Object
	Dim Dummy()
	Dim document   as Object
	Dim dispatcher as Object
		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
	' Dispatcher
		document   = oDoc.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	Dim oArgs1(0) as new com.sun.star.beans.PropertyValue
	Dim oArgs2(1) as new com.sun.star.beans.PropertyValue
	Dim oArgs3(0) as new com.sun.star.beans.PropertyValue
		for i = 1 to 3
			oWText = oDoc.getText()
			If i = 1 then
				oSubjOutline = "[ OutLine " & i & " ]" 
				oWText.insertString(oWText.getEnd(), oSubjOutline, false)
				oWText.insertControlCharacter(oWText.getEnd(), com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
			else
				oSubjOutline = Chr$(10) & "[ OutLine " & i & " ]" 
				oWText.insertString(oWText.getEnd(), oSubjOutline, false)
				oWText.insertControlCharacter(oWText.getEnd(), com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
			End If
		'
				oArgs1(0).Name = "NumRule"
				oArgs1(0).Value = "Numbering 1"
			dispatcher.executeDispatch(document, ".uno:NumRule", "", 0, oArgs1())
		'
				oArgs2(0).Name = "LineNumber.CountLines"
				oArgs2(0).Value = true
				oArgs2(1).Name = "LineNumber.StartValue"
				oArgs2(1).Value = 1
			dispatcher.executeDispatch(document, ".uno:LineNumber", "", 0, oArgs2())
		'
				oArgs3(0).Name = "NumberingStart"
				oArgs3(0).Value = true
			dispatcher.executeDispatch(document, ".uno:NumberingStart", "", 0, oArgs3())
		'
			oOutlineText = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						"This line is first paragraph too. But it is second line." & Chr$(13) & _
						"This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line." & Chr$(10)
			oWText.insertString(oWText.getEnd(), oOutlineText, false)
		next i
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg & Chr$(10) _
			& " i = " & i, 0, "Error Message")
End Sub

WOt-)[Writer]Outline設定2b



Sub WriterOutline()
	Dim oDoc as Object
	Dim Dummy()
	Dim document   as Object
	Dim dispatcher as Object
		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
	' Dispatcher
		document   = oDoc.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	Dim oArgs1(0) as new com.sun.star.beans.PropertyValue
	Dim oArgs2(1) as new com.sun.star.beans.PropertyValue
	Dim oArgs3(0) as new com.sun.star.beans.PropertyValue
		for i = 1 to 3
			oWText = oDoc.getText()
			If i = 1 then
				oSubjOutline = "[ OutLine " & i & " ]" 
				oWText.insertString(oWText.getEnd(), oSubjOutline, false)
				oWText.insertControlCharacter(oWText.getEnd(), com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
			else
				oSubjOutline = Chr$(10) & "[ OutLine " & i & " ]" 
				oWText.insertString(oWText.getEnd(), oSubjOutline, false)
				oWText.insertControlCharacter(oWText.getEnd(), com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
			End If
		'
				oArgs1(0).Name = "NumRule"
				oArgs1(0).Value = "Numbering 1"
			dispatcher.executeDispatch(document, ".uno:NumRule", "", 0, oArgs1())
		'
				oArgs2(0).Name = "LineNumber.CountLines"
				oArgs2(0).Value = true
				oArgs2(1).Name = "LineNumber.StartValue"
				oArgs2(1).Value = 1
			dispatcher.executeDispatch(document, ".uno:LineNumber", "", 0, oArgs2())
		'
				oArgs3(0).Name = "NumberingStart"
				oArgs3(0).Value = false
			dispatcher.executeDispatch(document, ".uno:NumberingStart", "", 0, oArgs3())
		'
			oOutlineText = "This is a document for macro test in writer. This line is first paragraph and first line." & Chr$(10) & _
						"This line is first paragraph too. But it is second line." & Chr$(13) & _
						"This line is second paragraph. It is third line." & Chr$(13) & _
						"This line is third  paragraph. It is fourth line." & Chr$(10)
			oWText.insertString(oWText.getEnd(), oOutlineText, false)
		next i
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg & Chr$(10) _
			& " i = " & i, 0, "Error Message")
End Sub

WOt-)[Writer]Outline設定3a( 1 2 3 4 )



Sub WriterOutlineParagraph()
	Dim oDoc
	Dim oDText
 	Dim Dummy()
 		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
 		oDText = oDoc.getText()
		' 
		oCursor = nothing
 
 		' ここでは定義済みの番号付けスタイル Outline を利用。必要に応じて作成
 			oRule = nothing
 			oRules = oDoc.getNumberingRules()
 			For i = 0 To oRules.getCount() - 1 step 1
   				If oRules.getByIndex(i).Name = "Outline" Then
     				oRule = oRules.getByIndex(i)
     				Exit For
   				End If
 			Next
 			'
 			If IsNull(oRule) Then Exit sub
 		'
 		' 番号付けスタイルの表示形式を変更
 		' change numbering type
 			For i = 0 To oRule.getCount() - 1 step 1
   				oLevel = oRule.getByIndex(i)
   				n = FindItemIndex(oLevel, "NumberingType")
   				If n >= 0 Then
     				oItem = oLevel(n)
     				If oItem.Value = 	com.sun.star.style.NumberingType.NUMBER_NONE Then
       					oItem.Value = com.sun.star.style.NumberingType.ARABIC
       					oLevel(n) = oItem
       					oRule.replaceByIndex(i, oLevel)
     				End If
   				End If
 			Next
 		'
 		' 段落の挿入と段落に番号付けを設定
 		Dim oStrPar(3)
 			oStrPar(0) = "This line is first paragraph. This is first line." 
			oStrPar(1) = "This line is second paragraph. It is third line."
			oStrPar(2) = "This line is third  paragraph. It is fourth line."
			oStrPar(3) = "This line is fourth  paragraph. It is fifth line."
		' 
 			For i = 0 To UBound(oStrPar) step 1
   				oPara = oDText.appendParagraph(Array())
   				oCursor = oDText.createTextCursorByRange(oPara)
   				oDText.insertString(oCursor, oStrPar(i), False)
   			'
   				oCursor.ParaStyleName = "Heading 1"
   				oCursor.NumberingRules = oRule
 			Next
End Sub

'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
	Dim nFound As Integer
		nFound = -1
		For i = 0 To UBound(aProps) step 1
  			If aProps(i).Name = sName Then
    			nFound = i
    			Exit For
  			End If
		Next
	FindItemIndex = nFound
End Function

WOt-)[Writer]Outline設定3b( A B C D )



Sub WriterOutlineParagraph()
	Dim oDoc
	Dim oDText
 	Dim Dummy()
 		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
 		oDText = oDoc.getText()
		' 
		oCursor = nothing
 			oRule = nothing
 			oRules = oDoc.getNumberingRules()
 			For i = 0 To oRules.getCount() - 1 step 1
   				If oRules.getByIndex(i).Name = "Outline" Then
     				oRule = oRules.getByIndex(i)
     				Exit For
   				End If
 			Next
 			'
 			If IsNull(oRule) Then Exit sub
 		'
 		' change numbering type
 			For i = 0 To oRule.getCount() - 1 step 1
   				oLevel = oRule.getByIndex(i)
   				n = FindItemIndex(oLevel, "NumberingType")
   				If n >= 0 Then
     				oItem = oLevel(n)
     				If oItem.Value = 	com.sun.star.style.NumberingType.NUMBER_NONE Then
       					oItem.Value = com.sun.star.style.NumberingType.CHARS_UPPER_LETTER
       					oLevel(n) = oItem
       					oRule.replaceByIndex(i, oLevel)
     				End If
   				End If
 			Next
 		'
 		' 段落の挿入と段落に番号付けを設定
 		Dim oStrPar(3)
 			oStrPar(0) = "This line is first paragraph. This is first line." 
			oStrPar(1) = "This line is second paragraph. It is third line."
			oStrPar(2) = "This line is third  paragraph. It is fourth line."
			oStrPar(3) = "This line is fourth  paragraph. It is fifth line."
		' 
 			For i = 0 To UBound(oStrPar) step 1
   				oPara = oDText.appendParagraph(Array())
   				oCursor = oDText.createTextCursorByRange(oPara)
   				oDText.insertString(oCursor, oStrPar(i), False)
   			'
   				oCursor.ParaStyleName = "Heading 1"
   				oCursor.NumberingRules = oRule
 			Next
End Sub

'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
	Dim nFound As Integer
		nFound = -1
		For i = 0 To UBound(aProps) step 1
  			If aProps(i).Name = sName Then
    			nFound = i
    			Exit For
  			End If
		Next
	FindItemIndex = nFound
End Function

WOt-)[Writer]Outline設定3c( a b c d )



Sub WriterOutlineParagraph()
	Dim oDoc
	Dim oDText
 	Dim Dummy()
 		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
 		oDText = oDoc.getText()
		' 
		oCursor = nothing
 			oRule = nothing
 			oRules = oDoc.getNumberingRules()
 			For i = 0 To oRules.getCount() - 1 step 1
   				If oRules.getByIndex(i).Name = "Outline" Then
     				oRule = oRules.getByIndex(i)
     				Exit For
   				End If
 			Next
 			'
 			If IsNull(oRule) Then Exit sub
 		'
 		' change numbering type
 			For i = 0 To oRule.getCount() - 1 step 1
   				oLevel = oRule.getByIndex(i)
   				n = FindItemIndex(oLevel, "NumberingType")
   				If n >= 0 Then
     				oItem = oLevel(n)
     				If oItem.Value = 	com.sun.star.style.NumberingType.NUMBER_NONE Then
       					oItem.Value = com.sun.star.style.NumberingType.CHARS_LOWER_LETTER
       					oLevel(n) = oItem
       					oRule.replaceByIndex(i, oLevel)
     				End If
   				End If
 			Next
 		'
 		' 段落の挿入と段落に番号付けを設定
 		Dim oStrPar(3)
 			oStrPar(0) = "This line is first paragraph. This is first line." 
			oStrPar(1) = "This line is second paragraph. It is third line."
			oStrPar(2) = "This line is third  paragraph. It is fourth line."
			oStrPar(3) = "This line is fourth  paragraph. It is fifth line."
		' 
 			For i = 0 To UBound(oStrPar) step 1
   				oPara = oDText.appendParagraph(Array())
   				oCursor = oDText.createTextCursorByRange(oPara)
   				oDText.insertString(oCursor, oStrPar(i), False)
   			'
   				oCursor.ParaStyleName = "Heading 1"
   				oCursor.NumberingRules = oRule
 			Next
End Sub

'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
	Dim nFound As Integer
		nFound = -1
		For i = 0 To UBound(aProps) step 1
  			If aProps(i).Name = sName Then
    			nFound = i
    			Exit For
  			End If
		Next
	FindItemIndex = nFound
End Function

WOt-)[Writer]Outline設定3d( ⅠⅡⅢⅣ )



Sub WriterOutlineParagraph()
	Dim oDoc
	Dim oDText
 	Dim Dummy()
 		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
 		oDText = oDoc.getText()
		' 
		oCursor = nothing
 			oRule = nothing
 			oRules = oDoc.getNumberingRules()
 			For i = 0 To oRules.getCount() - 1 step 1
   				If oRules.getByIndex(i).Name = "Outline" Then
     				oRule = oRules.getByIndex(i)
     				Exit For
   				End If
 			Next
 			'
 			If IsNull(oRule) Then Exit sub
 		'
 		' change numbering type
 			For i = 0 To oRule.getCount() - 1 step 1
   				oLevel = oRule.getByIndex(i)
   				n = FindItemIndex(oLevel, "NumberingType")
   				If n >= 0 Then
     				oItem = oLevel(n)
     				If oItem.Value = 	com.sun.star.style.NumberingType.NUMBER_NONE Then
       					oItem.Value = com.sun.star.style.NumberingType.ROMAN_UPPER
       					oLevel(n) = oItem
       					oRule.replaceByIndex(i, oLevel)
     				End If
   				End If
 			Next
 		'
 		' 段落の挿入と段落に番号付けを設定
 		Dim oStrPar(3)
 			oStrPar(0) = "This line is first paragraph. This is first line." 
			oStrPar(1) = "This line is second paragraph. It is third line."
			oStrPar(2) = "This line is third  paragraph. It is fourth line."
			oStrPar(3) = "This line is fourth  paragraph. It is fifth line."
		' 
 			For i = 0 To UBound(oStrPar) step 1
   				oPara = oDText.appendParagraph(Array())
   				oCursor = oDText.createTextCursorByRange(oPara)
   				oDText.insertString(oCursor, oStrPar(i), False)
   			'
   				oCursor.ParaStyleName = "Heading 1"
   				oCursor.NumberingRules = oRule
 			Next
End Sub

'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
	Dim nFound As Integer
		nFound = -1
		For i = 0 To UBound(aProps) step 1
  			If aProps(i).Name = sName Then
    			nFound = i
    			Exit For
  			End If
		Next
	FindItemIndex = nFound
End Function

WOt-)[Writer]Outline設定3e( ⅰⅱⅲⅳ )



Sub WriterOutlineParagraph()
	Dim oDoc
	Dim oDText
 	Dim Dummy()
 		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
 		oDText = oDoc.getText()
		' 
		oCursor = nothing
 			oRule = nothing
 			oRules = oDoc.getNumberingRules()
 			For i = 0 To oRules.getCount() - 1 step 1
   				If oRules.getByIndex(i).Name = "Outline" Then
     				oRule = oRules.getByIndex(i)
     				Exit For
   				End If
 			Next
 			'
 			If IsNull(oRule) Then Exit sub
 		'
 		' change numbering type
 			For i = 0 To oRule.getCount() - 1 step 1
   				oLevel = oRule.getByIndex(i)
   				n = FindItemIndex(oLevel, "NumberingType")
   				If n >= 0 Then
     				oItem = oLevel(n)
     				If oItem.Value = 	com.sun.star.style.NumberingType.NUMBER_NONE Then
       					oItem.Value = com.sun.star.style.NumberingType.ROMAN_LOWER
       					oLevel(n) = oItem
       					oRule.replaceByIndex(i, oLevel)
     				End If
   				End If
 			Next
 		'
 		' 段落の挿入と段落に番号付けを設定
 		Dim oStrPar(3)
 			oStrPar(0) = "This line is first paragraph. This is first line." 
			oStrPar(1) = "This line is second paragraph. It is third line."
			oStrPar(2) = "This line is third  paragraph. It is fourth line."
			oStrPar(3) = "This line is fourth  paragraph. It is fifth line."
		' 
 			For i = 0 To UBound(oStrPar) step 1
   				oPara = oDText.appendParagraph(Array())
   				oCursor = oDText.createTextCursorByRange(oPara)
   				oDText.insertString(oCursor, oStrPar(i), False)
   			'
   				oCursor.ParaStyleName = "Heading 1"
   				oCursor.NumberingRules = oRule
 			Next
End Sub

'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
	Dim nFound As Integer
		nFound = -1
		For i = 0 To UBound(aProps) step 1
  			If aProps(i).Name = sName Then
    			nFound = i
    			Exit For
  			End If
		Next
	FindItemIndex = nFound
End Function

WOt-)[Writer]Outline設定3f( 壱弐参四 )



Sub WriterOutlineParagraph()
	Dim oDoc
	Dim oDText
 	Dim Dummy()
 		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
 		oDText = oDoc.getText()
		' 
		oCursor = nothing
 			oRule = nothing
 			oRules = oDoc.getNumberingRules()
 			For i = 0 To oRules.getCount() - 1 step 1
   				If oRules.getByIndex(i).Name = "Outline" Then
     				oRule = oRules.getByIndex(i)
     				Exit For
   				End If
 			Next
 			'
 			If IsNull(oRule) Then Exit sub
 		'
 		' change numbering type
 			For i = 0 To oRule.getCount() - 1 step 1
   				oLevel = oRule.getByIndex(i)
   				n = FindItemIndex(oLevel, "NumberingType")
   				If n >= 0 Then
     				oItem = oLevel(n)
     				If oItem.Value = 	com.sun.star.style.NumberingType.NUMBER_NONE Then
       					oItem.Value = com.sun.star.style.NumberingType.NUMBER_TRADITIONAL_JA
       					oLevel(n) = oItem
       					oRule.replaceByIndex(i, oLevel)
     				End If
   				End If
 			Next
 		'
 		' 段落の挿入と段落に番号付けを設定
 		Dim oStrPar(3)
 			oStrPar(0) = "This line is first paragraph. This is first line." 
			oStrPar(1) = "This line is second paragraph. It is third line."
			oStrPar(2) = "This line is third  paragraph. It is fourth line."
			oStrPar(3) = "This line is fourth  paragraph. It is fifth line."
		' 
 			For i = 0 To UBound(oStrPar) step 1
   				oPara = oDText.appendParagraph(Array())
   				oCursor = oDText.createTextCursorByRange(oPara)
   				oDText.insertString(oCursor, oStrPar(i), False)
   			'
   				oCursor.ParaStyleName = "Heading 1"
   				oCursor.NumberingRules = oRule
 			Next
End Sub

'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
	Dim nFound As Integer
		nFound = -1
		For i = 0 To UBound(aProps) step 1
  			If aProps(i).Name = sName Then
    			nFound = i
    			Exit For
  			End If
		Next
	FindItemIndex = nFound
End Function

WOt-)[Writer]Outline設定3g( アイウエ )



Sub WriterOutlineParagraph()
	Dim oDoc
	Dim oDText
 	Dim Dummy()
 		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
 		oDText = oDoc.getText()
		' 
		oCursor = nothing
 			oRule = nothing
 			oRules = oDoc.getNumberingRules()
 			For i = 0 To oRules.getCount() - 1 step 1
   				If oRules.getByIndex(i).Name = "Outline" Then
     				oRule = oRules.getByIndex(i)
     				Exit For
   				End If
 			Next
 			'
 			If IsNull(oRule) Then Exit sub
 		'
 		' change numbering type
 			For i = 0 To oRule.getCount() - 1 step 1
   				oLevel = oRule.getByIndex(i)
   				n = FindItemIndex(oLevel, "NumberingType")
   				If n >= 0 Then
     				oItem = oLevel(n)
     				If oItem.Value = 	com.sun.star.style.NumberingType.NUMBER_NONE Then
       					oItem.Value = com.sun.star.style.NumberingType.AIU_FULLWIDTH_JA
       					oLevel(n) = oItem
       					oRule.replaceByIndex(i, oLevel)
     				End If
   				End If
 			Next
 		'
 		' 段落の挿入と段落に番号付けを設定
 		Dim oStrPar(3)
 			oStrPar(0) = "This line is first paragraph. This is first line." 
			oStrPar(1) = "This line is second paragraph. It is third line."
			oStrPar(2) = "This line is third  paragraph. It is fourth line."
			oStrPar(3) = "This line is fourth  paragraph. It is fifth line."
		' 
 			For i = 0 To UBound(oStrPar) step 1
   				oPara = oDText.appendParagraph(Array())
   				oCursor = oDText.createTextCursorByRange(oPara)
   				oDText.insertString(oCursor, oStrPar(i), False)
   			'
   				oCursor.ParaStyleName = "Heading 1"
   				oCursor.NumberingRules = oRule
 			Next
End Sub

'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
	Dim nFound As Integer
		nFound = -1
		For i = 0 To UBound(aProps) step 1
  			If aProps(i).Name = sName Then
    			nFound = i
    			Exit For
  			End If
		Next
	FindItemIndex = nFound
End Function

WOt-)[Writer]Outline設定3h( ァイゥェ )



Sub WriterOutlineParagraph()
	Dim oDoc
	Dim oDText
 	Dim Dummy()
 		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
 		oDText = oDoc.getText()
		' 
		oCursor = nothing
 			oRule = nothing
 			oRules = oDoc.getNumberingRules()
 			For i = 0 To oRules.getCount() - 1 step 1
   				If oRules.getByIndex(i).Name = "Outline" Then
     				oRule = oRules.getByIndex(i)
     				Exit For
   				End If
 			Next
 			'
 			If IsNull(oRule) Then Exit sub
 		'
 		' change numbering type
 			For i = 0 To oRule.getCount() - 1 step 1
   				oLevel = oRule.getByIndex(i)
   				n = FindItemIndex(oLevel, "NumberingType")
   				If n >= 0 Then
     				oItem = oLevel(n)
     				If oItem.Value = 	com.sun.star.style.NumberingType.NUMBER_NONE Then
       					oItem.Value = com.sun.star.style.NumberingType.AIU_HALFWIDTH_JA
       					oLevel(n) = oItem
       					oRule.replaceByIndex(i, oLevel)
     				End If
   				End If
 			Next
 		'
 		' 段落の挿入と段落に番号付けを設定
 		Dim oStrPar(3)
 			oStrPar(0) = "This line is first paragraph. This is first line." 
			oStrPar(1) = "This line is second paragraph. It is third line."
			oStrPar(2) = "This line is third  paragraph. It is fourth line."
			oStrPar(3) = "This line is fourth  paragraph. It is fifth line."
		' 
 			For i = 0 To UBound(oStrPar) step 1
   				oPara = oDText.appendParagraph(Array())
   				oCursor = oDText.createTextCursorByRange(oPara)
   				oDText.insertString(oCursor, oStrPar(i), False)
   			'
   				oCursor.ParaStyleName = "Heading 1"
   				oCursor.NumberingRules = oRule
 			Next
End Sub

'[ Function 1 ]
Function FindItemIndex(aProps As Object, sName As String) As Integer
	Dim nFound As Integer
		nFound = -1
		For i = 0 To UBound(aProps) step 1
  			If aProps(i).Name = sName Then
    			nFound = i
    			Exit For
  			End If
		Next
	FindItemIndex = nFound
End Function

WOt-)[Writer](未完成)Outline設定



Sub oOutlineInWrite
  	Dim oDoc
  	Dim oDText
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
	'
  	Dim oRules
  	Dim oRule()
  	Dim oProp
  	Dim oNames(0)
  		oNames(0) = "_New_Heading_1"
  		oRules = oDoc.getChapterNumberingRules()
  		For i = 0 To UBound(oNames())
    		If i >= oRules.getCount() Then Exit Sub
    		oRule() = oRules.getByIndex(i)
    		For j = LBound(oRule()) To Ubound(oRule())
      			oProp = oRule(j)
      			Select Case oProp.Name
      				Case "HeadingStyleName"
        				oProp.Value = oNames(i)
      				Case "NumberingType"
        				oProp.Value = com.sun.star.style.NumberingType.ARABIC
      				Case "ParentNumbering"
        				oProp.Value = i + 1
      				Case "Prefix"
        				oProp.Value = ""
      				Case "Suffix"
        				oProp.Value = " " 
      			End Select
      			oRule(j) = oProp
    		Next j
    		oRules.replaceByIndex(i, oRule())
  		Next i	
  		'
  	Dim oFamilies
  	Dim oParaStyles
  	Dim oStyle
  		oFamilies = oDoc.StyleFamilies
  		oParaStyles = oFamilies.getByName("ParagraphStyles")
  		'
    	oStyle = oDoc.createInstance("com.sun.star.style.ParagraphStyle")
    	oStyle.setParentStyle("Heading")
    	'
    	oStyle.CharHeight = 20
    	oParaStyles.insertByName(oNames(0), oStyle)
    '	
    	oDText = oDoc.getText()
			oDisp = "This line is first paragraph. This is first line." & Chr$(13) & _
				"This line is second paragraph. It is third line." & Chr$(13) & _
				"This line is third  paragraph. It is fourth line." & Chr$(13) & _
				"This line is fourth  paragraph. It is fifth line."
			oDText.insertString(oDText.getEnd(), oDisp, true)
End Sub

WOt-)[Writer]

Sort

WSort-)[Writer](未完成)Sort in writer



Sub oSortTextInWrite
  	Dim oDoc
  	Dim oDText
  	Dim oText    'Text object for the current object
  	Dim oVCursor 'Current view cursor
  	Dim oCursor  'Text cursor
  	Dim oSort
  	Dim Dummy()
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())	
  		oDText = oDoc.getText()
			oDisp = "This line is first paragraph. This is first line." & Chr$(13) & _
				"This line is second paragraph. It is third line." & Chr$(13) & _
				"This line is third  paragraph. It is fourth line." & Chr$(13) & _
				"This line is fourth  paragraph. It is fifth line."
			oDText.insertString(oDText.getEnd(), oDisp, false)
  		'
  		oVCursor = oDoc.getCurrentController().getViewCursor()
  		oText = oVCursor.getText()
  		oCursor = oText.createTextCursorByRange(oVCursor)
  		oSort = oCursor.createSortDescriptor()
 		'
  		oCursor.sort(oSort)
End Sub

WSort-)[Writer]

Printer

WP-)[Writer]PagePrintProperties



Sub oDisplayPagePrintProperties
	Dim oprops as Object
	Dim i%
	Dim oDisp
		On Error Goto oBad
		oDoc = ThisComponent
		ouno = "com.sun.star.text.XPagePrintable"
	'get File Name
		oURL = oDoc.getURL()
		oName = COnvertFromUrl(oURL)
		oDisp = "[ " & oName & " ]" & Chr$(10) & Chr$(10)
	'get Page Print Properties
		If HasUnoInterfaces(oDoc,ouno) then
			oprops = oDOc.getPagePrintSettings()
			for i = 0 to UBound(oprops)
				oDisp = oDisp & oprops(i).Name & " = "
				oDisp = oDisp & CStr(oprops(i).Value)
				oDisp = oDisp & Chr$(10)
			next i
			msgbox(oDisp , 0, "Page Print Properties")
		else
			msgbox("This Document does not support" & Chr$(10) & _
						"the XpagePrintable interface",0,"Caution!!")
		End If
		
		Exit Sub
	oBad: 
		mErr = Error
		msgbox(mErr & " : i = " & i )
End Sub

WP-)[Writer]2列割pageの印刷1


Sub oDisplayPagePrintProperties
	Dim oprops(0 to 1) as New com.sun.star.beans.PropertyValue
	Dim i%
	Dim oDisp
		On Error Goto oBad
		oDoc = ThisComponent
		ouno = "com.sun.star.text.XPagePrintable"
	'set Page Print Properties
		oprops(0).Name = "PageColumns"
		oprops(0).Value = 2
		oprops(1).Name = "IsLandscape"
		oprops(1).Value = true
		If HasUnoInterfaces(oDoc,ouno) then
			oDoc.setPagePrintSettings(oprops())
			oDoc.printPages(Array())
		else
			msgbox("This Document does not support" & Chr$(10) & _
						"the XpagePrintable interface",0,"Caution!!")
		End If		
		Exit Sub
	oBad: 
		mErr = Error
		lErr =Erl
		msgbox(mErr & " : i = " & i  & Chr$(10) & "Error Line = " &lErr )
End Sub

WP-)[Writer]2列割pageの印刷2


Sub oPrintTwoCloumnPerPage2
	Dim osettings
	Dim oset
	Dim i%
		On Error Goto oBad		
		oDoc = ThisComponent
		'set Page Print Properties
			osettings = oDoc.getPagePrintSettings()
			oset = osettings(1)
			for i = LBound(osettings) to UBound(osettings)
				oset = osettings(i)
				If oset.name = "PageColumns" then
					oset.value = 2
					osettings(i) = oset
				End If
				If oset.name = "IsLandscape" then
					oset.value = true
					osettings(i) = oset
				End If
			next i
			oDoc.printPages(osettings)		
		Exit Sub
	oBad: 
		mErr = Error
		lErr =Erl
		msgbox(mErr & " : i = " & i  & Chr$(10) & "Error Line = " &lErr )
End Sub

WP-)[Writer]

Shape[Writer]

WS-)[Writer](未完成)Document中のShape抽出


Sub oShapeinWriter	'	未完成
	Dim oDrawPage
	Dim oShape
	Dim i%
	Dim sGroupShape
	Dim sControlShape
		sGroupShape   = "com.sun.star.drawing.GroupShape"
		sControlShape = "com.sun.star.drawing.ControlShape"
		'oDrawPage = ThisComponent.getDrawPage()	': print oDrawPage.getCount
		oDoc = ThisComponent
		a = oDoc.supportsService(sControlShape)
		b = oDoc.supportsService("com.sun.star.drawing.GenericDrawPage")
		print b		
End Sub

Form

WFm-)[Writer]ComboBox作成



Sub oPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     '
     '
     Dim oList(5) as String
     oList(0) = "Zero"
     oList(1) = "One"
     oList(2) = "Two"
     oList(3) = "Three"
     oList(4) = "Four"
     oList(5) = "Five"
     '
     '
     Dim oControlShape as Object
     Dim oControlModel as Object
 		'
         ' a shape
         oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
         positionShape( oControlShape, 1000, 1000 , 5000, 600 )
         
         ' a control model
         ' Combo Box
		oControlModel = oDoc.createInstance("com.sun.star.form.component.ComboBox")
		oControlModel.Name = "NumberSelection"
		oControlModel.Text = "Zero"
		oControlModel.Dropdown = True
		oControlModel.StringItemList = oList()
		'
	 	oSampleForm.insertByIndex( 0, oControlModel )
		'
		' knit both
         oControlShape.Control = oControlModel
         '
         ' add the shape to the DrawPage
         oDoc.DrawPage.add( oControlShape )
		'
		' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
		Dim oFrame as object
		Dim dispatcher as object
			oFrame   = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		Dim args1(0) as new com.sun.star.beans.PropertyValue
			args1(0).Name = "SwitchControlDesignMode"
			args1(0).Value = false
				dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
 End Sub
 
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
     oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH

     Dim oPos as new com.sun.star.awt.Point
     oPos.X = X
     oPos.Y = Y
     oShape.setPosition( oPos )
     Erase oPos
 
     Dim oSize as new com.sun.star.awt.Size
     oSize.Width = Width
     oSize.Height = Height
     oShape.setSize( oSize )
     Erase oSize
End Sub

WFm-)[Writer]ComboBox値取得



Sub oGetPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     '
     '
     Dim oList(5) as String
     oList(0) = "Zero"
     oList(1) = "One"
     oList(2) = "Two"
     oList(3) = "Three"
     oList(4) = "Four"
     oList(5) = "Five"
     '
     '
     Dim oControlShape as Object
     Dim oControlModel as Object
 		'
         ' a shape
         oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
         oGetPositionShape( oControlShape, 1000, 1000 , 5000, 600 )
         
         ' a control model
         ' Combo Box
		oControlModel = oDoc.createInstance("com.sun.star.form.component.ComboBox")
		oControlModel.Name = "NumberSelection"
		oControlModel.Text = "Two"
		oControlModel.Dropdown = True
		oControlModel.StringItemList = oList()
		oSampleForm.insertByIndex( 0, oControlModel )
        oControlModel.StringItemList = oList()
		'
		' knit both
         oControlShape.Control = oControlModel
         '
         ' add the shape to the DrawPage
         oDoc.DrawPage.add( oControlShape )
		'
		' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
		Dim oFrame as object
		Dim dispatcher as object
			oFrame   = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		Dim args1(0) as new com.sun.star.beans.PropertyValue
			args1(0).Name = "SwitchControlDesignMode"
			args1(0).Value = false
				dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
		'
		' 値の取得
		Dim oPForm as Object
		Dim oPFCtrlM as Object
		Dim oSelectItem as String
		Dim oDisp as String
		Dim i as Integer
			oPForm = oFormsCollection.getByIndex(0)
			oPFCtrlM = oPForm.getControlModels()
			for i = 0 to UBound(oPFCtrlM)
				oSelectItem = oPFCtrlM(i).Text
				' oSelectItem = oPFCtrlM(i).CurrentValue		' こちらでも取得できる。
				oDisp = oDisp & oSelectItem & Chr$(10)
			next i			
		' Display
		msgbox(oDisp, 0, "ComboBox選択項目")
 End Sub
 
Sub oGetPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
     oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH

     Dim oPos as new com.sun.star.awt.Point
     oPos.X = X
     oPos.Y = Y
     oShape.setPosition( oPos )
     Erase oPos
 
     Dim oSize as new com.sun.star.awt.Size
     oSize.Width = Width
     oSize.Height = Height
     oShape.setSize( oSize )
     Erase oSize
End Sub

WFm-)[Writer]ListBox作成



Sub oPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     '
     '
     Dim oList(5) as String
     oList(0) = "Zero"
     oList(1) = "One"
     oList(2) = "Two"
     oList(3) = "Three"
     oList(4) = "Four"
     oList(5) = "Five"
     '
     '
     Dim oControlShape as Object
     Dim oControlModel as Object
 		'
         ' a shape
         oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
         positionShape( oControlShape, 1000, 1000 , 2000, 3000 )
         
       ' ControlShape
		oControlModel = oDoc.createInstance("com.sun.star.form.component.ListBox")
		oControlModel.reset()
		oControlModel.commit()
		oControlModel.refresh()
		oControlModel.DropDown = false								' DropDown表示　MultiSelect => trueならば　falseにする
		oControlModel.Enabled = True 
		oControlModel.Name = "NumberSelection"
		oControlModel.MultiSelection =  true						' 複数選択
		oControlModel.BackgroundColor = &HC8FFB9			 'verdolino 
		oControlModel.FontHeight = 12 
		oControlModel.FontWeight = com.sun.star.awt.FontWeight.BOLD 
		oControlModel.LineCount = 6			' 表示する項目数
		'
		' knit both
         oControlShape.Control = oControlModel
         '
         ' add the shape to the DrawPage
         oDoc.DrawPage.add( oControlShape )
		'
		'add thelist items to the listbox
		Dim frm as Object
		Dim oListBoxModel as Object
		Dim ctrl as Object
		Dim oListBoxView as Object 
			frm=oFormsCollection.getByIndex(0) 
			oListBoxModel=frm.getByName("NumberSelection") 
			ctrl = oDoc.CurrentController 
			oListBoxView = ctrl.getControl(oListBoxModel) 
				oListBoxView.addItems(oList, 0, 1, 2, 3, 4, 5) 
				oListBoxView.selectItemPos(0,false)
		'
		' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
		Dim oFrame as object
		Dim dispatcher as object
			oFrame   = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		Dim args1(0) as new com.sun.star.beans.PropertyValue
			args1(0).Name = "SwitchControlDesignMode"
			args1(0).Value = false
				dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
 End Sub
 
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
     oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH

     Dim oPos as new com.sun.star.awt.Point
     oPos.X = X
     oPos.Y = Y
     oShape.setPosition( oPos )
     Erase oPos
 
     Dim oSize as new com.sun.star.awt.Size
     oSize.Width = Width
     oSize.Height = Height
     oShape.setSize( oSize )
     Erase oSize
End Sub

WFm-)[Writer]ListBox値取得



Sub oGetPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     '
     '
     Dim oList(5) as String
     oList(0) = "Zero"
     oList(1) = "One"
     oList(2) = "Two"
     oList(3) = "Three"
     oList(4) = "Four"
     oList(5) = "Five"
     '
     '
     Dim oControlShape as Object
     Dim oControlModel as Object
 		'
         ' a shape
         oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
         oGetPositionShape( oControlShape, 1000, 1000 , 2000, 3000 )
        
        ' ControlShape / ListBox
		oControlModel = oDoc.createInstance("com.sun.star.form.component.ListBox")
		oControlModel.reset()
		oControlModel.commit()
		oControlModel.refresh()
		oControlModel.DropDown = false								' DropDown表示　MultiSelect => trueならば　falseにする
		oControlModel.Enabled = True 
		oControlModel.Name = "NumberSelection"
		oControlModel.MultiSelection =  true						' 複数選択
		oControlModel.BackgroundColor = &HC8FFB9			 'verdolino 
		oControlModel.FontHeight = 12 
		oControlModel.FontWeight = com.sun.star.awt.FontWeight.BOLD 
		oControlModel.LineCount = 6			' 表示する項目数
		'
		' knit both
         oControlShape.Control = oControlModel
         '
         ' add the shape to the DrawPage
         oDoc.DrawPage.add( oControlShape )
		'
		'add thelist items to the listbox
		Dim frm as Object
		Dim oListBoxModel as Object
		Dim ctrl as Object
		Dim oListBoxView as Object 
			frm=oFormsCollection.getByIndex(0) 
			oListBoxModel=frm.getByName("NumberSelection") 
			ctrl = oDoc.CurrentController 
			oListBoxView = ctrl.getControl(oListBoxModel) 
				oListBoxView.addItems(oList, 0, 1, 2, 3, 4, 5) 
				oListBoxView.selectItemPos(1,true)				' 初期設定　0を選択(falseで選択無し)
		'
		' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
		Dim oFrame as object
		Dim dispatcher as object
			oFrame   = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		Dim args1(0) as new com.sun.star.beans.PropertyValue
			args1(0).Name = "SwitchControlDesignMode"
			args1(0).Value = false
				dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
		'
		' 値の取得
		Dim oPForm as Object
		Dim oPFEltCount as Long
		Dim oPFElement as Object
		Dim oSelectItem as Object
		Dim i ,j as Integer
		Dim oDisp as String
			oPForm = oFormsCollection.getByIndex(0)
			oPFEltCount = oPForm.getCount()
			If oPFEltCount < 1 then
				oDisp = "項目が選択されていません。"
				msgbox(oDisp, 0, "ListBoxの項目")
				Exit Sub
			End If
			oDisp = ""
			for i = 0 to oPFEltCount-1
				oPFElement = oPForm.getByIndex(i)
				oSelectItem = oPFElement.getCurrentValue()
				for j = 0 to UBound(oSelectItem)
					oDisp = oDisp & oSelectItem(j) & Chr(10)
				next j
			next i
			msgbox(oDisp, 0, "ListBox 選択されている項目")
End Sub
' 
Sub oGetPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
     oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
     Dim oPos as new com.sun.star.awt.Point
     oPos.X = X
     oPos.Y = Y
     oShape.setPosition( oPos )
     Erase oPos
 	'
     Dim oSize as new com.sun.star.awt.Size
     oSize.Width = Width
     oSize.Height = Height
     oShape.setSize( oSize )
     Erase oSize
End Sub

WFm-)[Writer]CheckBox作成



Sub oPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     '
     '
     Dim oList(5) as String
     oList(0) = "Zero"
     oList(1) = "One"
     oList(2) = "Two"
     oList(3) = "Three"
     oList(4) = "Four"
     oList(5) = "Five"
     '
     '
     Dim oControlShape as Object
     Dim oControlModel as Object
 		'
        Dim i as Integer
     For i = 0 To 5
        ' a shape
        oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
        positionShape( oControlShape, 1000, 1000 + i * 800, 5000, 600 )
        ' 
        ' a control model
        oControlModel = createUnoService( "com.sun.star.form.component.CheckBox" )
        oControlModel.Name = "Number"
        oControlModel.Label = UCase( oList( i ) )
        oControlModel.Tag = oList( i )
        If i = 1 or i = 3 then
			oControlModel.State = 1
		End If 
        oSampleForm.insertByIndex( i, oControlModel )
        ' 
        ' knit both
        oControlShape.Control = oControlModel
        ' 
        ' add the shape to the DrawPage
        oDoc.DrawPage.add( oControlShape )
     Next i
	'
     ' set the focus to the first control
     	oDoc.CurrentController.getControl( oSampleForm.getByIndex( 0 ) ).setFocus
	'
	' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
	Dim oFrame as object
	Dim dispatcher as object
		oFrame   = oDoc.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
	Dim args1(0) as new com.sun.star.beans.PropertyValue
		args1(0).Name = "SwitchControlDesignMode"
		args1(0).Value = false
			dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
End Sub
'
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
	oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
	Dim oPos as new com.sun.star.awt.Point
    	oPos.X = X
     	oPos.Y = Y
     	oShape.setPosition( oPos )
     	Erase oPos
 	'
    Dim oSize as new com.sun.star.awt.Size
    	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
     	Erase oSize
End Sub

WFm-)[Writer]CheckBox値取得



Sub oGetPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
    '
    Dim oList(5) as String
    	oList(0) = "Zero"
     	oList(1) = "One"
     	oList(2) = "Two"
     	oList(3) = "Three"
     	oList(4) = "Four"
     	oList(5) = "Five"
     '
    Dim oControlShape as Object
    Dim oControlModel as Object
 	'
    Dim i as Integer
    	For i = 0 To 5
        	' a shape
        	oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
        	positionShape( oControlShape, 1000, 1000 + i * 800, 5000, 600 )
        	' 
        	' a control model
        	oControlModel = createUnoService( "com.sun.star.form.component.CheckBox" )
        	oControlModel.Name = "Number"
        	oControlModel.Label = UCase( oList( i ) )
        	oControlModel.Tag = oList( i )
        	If i = 1 or i = 3 then
				oControlModel.State = 1
			End If 
        	oSampleForm.insertByIndex( i, oControlModel )
        	' 
        	' knit both
        	oControlShape.Control = oControlModel
        	' 
        	' add the shape to the DrawPage
        	oDoc.DrawPage.add( oControlShape )
     	Next i
	'
    ' set the focus to the first control
     	oDoc.CurrentController.getControl( oSampleForm.getByIndex( 0 ) ).setFocus
		'
	' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
	Dim oFrame as object
	Dim dispatcher as object
		oFrame   = oDoc.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
	Dim args1(0) as new com.sun.star.beans.PropertyValue
		args1(0).Name = "SwitchControlDesignMode"
		args1(0).Value = false
		dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
	'
	' 値の取得
	Dim oPForm as Object
	Dim oPFEltCount as Long
	Dim oPFElement as Object
	Dim oRButtonOnOff as Integer
	Dim oSelectItem as String
	Dim oDisp as String
		oPForm = oFormsCollection.getByIndex(0)
		oPFEltCount = oPForm.getCount()
		oDisp = ""
		for i = 0 to oPFEltCount - 1
			oPFElement = oPForm.getByIndex(i)
			If oPFElement.supportsService("com.sun.star.form.component.CheckBox") then
				oRButtonOnOff = oPFElement.State
				If oRButtonOnOff = 1 then
					oSelectItem = oPFElement.Label
					oDisp = oDisp & oSelectItem & Chr$(10)
				End If
			End If
		next i
	' Display
		msgbox(oDisp, 0, "CheckBox選択Item")
End Sub
' 
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
    oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
	Dim oPos as new com.sun.star.awt.Point
    	oPos.X = X
    	oPos.Y = Y
    	oShape.setPosition( oPos )
    	Erase oPos
 	'
    Dim oSize as new com.sun.star.awt.Size
    	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
     	Erase oSize
End Sub

WFm-)[Writer]GroupBox(CheckBox)値取得



Sub oPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     '
     '
     Dim oList(5) as String
     oList(0) = "Zero"
     oList(1) = "One"
     oList(2) = "Two"
     oList(3) = "Three"
     oList(4) = "Four"
     oList(5) = "Five"
     '
     ' **** [ GroupBox ] ****
     Dim oGroup as Object
     Dim oShapeGr as Object
     Dim oControlModelGr as Object
     	oGroup = createUnoService("com.sun.star.drawing.ShapeCollection")
     	oShapeGr = oDoc.createInstance("com.sun.star.drawing.ControlShape")
     	positionShape( oShapeGr, 500, 200, 2500, 5500 )
		'
     	oControlModelGr = oDoc.createInstance("com.sun.star.form.component.GroupBox")
		oControlModelGr.Name = "グループボックス 1"
		oControlModelGr.Label = "GroupBox1"
		'
		oShapeGr.Control = oControlModelGr
		oSampleForm.insertByIndex( 0, oControlModelGr )
		oDoc.DrawPage.add( oShapeGr )
		oGroup.add( oShapeGr )
	' *******************
    '
    Dim oControlShape as Object
    Dim oControlModel as Object
 	Dim i as Integer
    	 For i = 0 To 5
        	' a shape
        	oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
        	positionShape( oControlShape, 1000, 1000 + i * 800, 5000, 600 )
        	' 
        	' a control model
        	oControlModel = createUnoService( "com.sun.star.form.component.CheckBox" )
        	oControlModel.Name = "Number"
        	oControlModel.Label = UCase( oList( i ) )
        	If i = 2 or i=  3 or i = 5 then
        		oControlModel.State = 1
        	End If
        	oControlModel.Tag = oList( i )
        	oSampleForm.insertByIndex( i, oControlModel )
        	'	 
        	' knit both
        	oControlShape.Control = oControlModel
        	' 
        	' add the shape to the DrawPage
        	oDoc.DrawPage.add( oControlShape )
     	Next i
     	'
	'
    ' set the focus to the first control
     	oDoc.CurrentController.getControl( oSampleForm.getByIndex( 0 ) ).setFocus
	'
	' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
	Dim oFrame as object
	Dim dispatcher as object
		oFrame   = oDoc.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
	Dim args1(0) as new com.sun.star.beans.PropertyValue
		args1(0).Name = "SwitchControlDesignMode"
		args1(0).Value = false
			dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
	'
	' 値の取得
	Dim oPForm as Object
	Dim oPFEltCount as Long
	Dim oPFElement as Object
	Dim oRButtonOnOff as Integer
	Dim oSelectItem as String
	Dim oDisp as String
		oPForm = oFormsCollection.getByIndex(0)
		oPFEltCount = oPForm.getCount()
		oDisp = ""
		for i = 0 to oPFEltCount - 1
			oPFElement = oPForm.getByIndex(i)
			If oPFElement.supportsService("com.sun.star.form.component.CheckBox") then
				oRButtonOnOff = oPFElement.State
				If oRButtonOnOff = 1 then
					oSelectItem = oPFElement.Label
					oDisp = oDisp & oSelectItem & Chr$(10)
				End If
			End If
		next i
	' Display
		msgbox(oDisp, 0, "GroupBox選択Item")
End Sub
'
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
	oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
	Dim oPos as new com.sun.star.awt.Point
    	oPos.X = X
     	oPos.Y = Y
     	oShape.setPosition( oPos )
     	Erase oPos
 	'
    Dim oSize as new com.sun.star.awt.Size
    	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
     	Erase oSize
End Sub

WFm-)[Writer]RadioButton作成



Sub oPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     '
     '
     Dim oList(5) as String
     oList(0) = "Zero"
     oList(1) = "One"
     oList(2) = "Two"
     oList(3) = "Three"
     oList(4) = "Four"
     oList(5) = "Five"
     '
     '
     Dim oControlShape as Object
     Dim oControlModel as Object
 		'
        Dim i as Integer
     For i = 0 To 5
        ' a shape
        oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
        positionShape( oControlShape, 1000, 1000 + i * 800, 5000, 600 )
        ' 
        ' a control model
        oControlModel = createUnoService( "com.sun.star.form.component.RadioButton" )
        oControlModel.Name = "Number"
        oControlModel.Label = UCase( oList( i ) )
        oControlModel.Tag = oList( i )
        oSampleForm.insertByIndex( i, oControlModel )
        ' 
        ' knit both
        oControlShape.Control = oControlModel
        ' 
        ' add the shape to the DrawPage
        oDoc.DrawPage.add( oControlShape )
     Next i
	'
     ' set the focus to the first control
     	oDoc.CurrentController.getControl( oSampleForm.getByIndex( 0 ) ).setFocus
	'
	' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
	Dim oFrame as object
	Dim dispatcher as object
		oFrame   = oDoc.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
	Dim args1(0) as new com.sun.star.beans.PropertyValue
		args1(0).Name = "SwitchControlDesignMode"
		args1(0).Value = false
			dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
End Sub
'
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
	oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
	Dim oPos as new com.sun.star.awt.Point
    	oPos.X = X
     	oPos.Y = Y
     	oShape.setPosition( oPos )
     	Erase oPos
 	'
    Dim oSize as new com.sun.star.awt.Size
    	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
     	Erase oSize
End Sub

WFm-)[Writer]GroupBox(RadioButton)作成



Sub oPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     '
     '
     Dim oList(5) as String
     oList(0) = "Zero"
     oList(1) = "One"
     oList(2) = "Two"
     oList(3) = "Three"
     oList(4) = "Four"
     oList(5) = "Five"
     '
     ' **** [ GroupBox ] ****
     Dim oGroup as Object
     Dim oShapeGr as Object
     Dim oControlModelGr as Object
     	oGroup = createUnoService("com.sun.star.drawing.ShapeCollection")
     	oShapeGr = oDoc.createInstance("com.sun.star.drawing.ControlShape")
     	positionShape( oShapeGr, 500, 200, 2500, 5500 )
		'
     	oControlModelGr = oDoc.createInstance("com.sun.star.form.component.GroupBox")
		oControlModelGr.Name = "グループボックス 1"
		oControlModelGr.Label = "GroupBox1"
		'
		oShapeGr.Control = oControlModelGr
		oSampleForm.insertByIndex( 0, oControlModelGr )
		oDoc.DrawPage.add( oShapeGr )
		oGroup.add( oShapeGr )
	' *******************
    '
    Dim oControlShape as Object
    Dim oControlModel as Object
 	Dim i as Integer
    	 For i = 0 To 5
        	' a shape
        	oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
        	positionShape( oControlShape, 1000, 1000 + i * 800, 5000, 600 )
        	' 
        	' a control model
        	oControlModel = createUnoService( "com.sun.star.form.component.RadioButton" )
        	oControlModel.Name = "Number"
        	oControlModel.Label = UCase( oList( i ) )
        	If i = 3 then
        		oControlModel.State = 1
        	End If
        	oControlModel.Tag = oList( i )
        	oSampleForm.insertByIndex( i, oControlModel )
        	'	 
        	' knit both
        	oControlShape.Control = oControlModel
        	' 
        	' add the shape to the DrawPage
        	oDoc.DrawPage.add( oControlShape )
     	Next i
     	'
	'
    ' set the focus to the first control
     	oDoc.CurrentController.getControl( oSampleForm.getByIndex( 0 ) ).setFocus
	'
	' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
	Dim oFrame as object
	Dim dispatcher as object
		oFrame   = oDoc.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
	Dim args1(0) as new com.sun.star.beans.PropertyValue
		args1(0).Name = "SwitchControlDesignMode"
		args1(0).Value = false
			dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
End Sub
'
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
	oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
	Dim oPos as new com.sun.star.awt.Point
    	oPos.X = X
     	oPos.Y = Y
     	oShape.setPosition( oPos )
     	Erase oPos
 	'
    Dim oSize as new com.sun.star.awt.Size
    	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
     	Erase oSize
End Sub

WFm-)[Writer]GroupBox(RadioButton)値取得



Sub oPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     '
     '
     Dim oList(5) as String
     oList(0) = "Zero"
     oList(1) = "One"
     oList(2) = "Two"
     oList(3) = "Three"
     oList(4) = "Four"
     oList(5) = "Five"
     '
     ' **** [ GroupBox ] ****
     Dim oGroup as Object
     Dim oShapeGr as Object
     Dim oControlModelGr as Object
     	oGroup = createUnoService("com.sun.star.drawing.ShapeCollection")
     	oShapeGr = oDoc.createInstance("com.sun.star.drawing.ControlShape")
     	positionShape( oShapeGr, 500, 200, 2500, 5500 )
		'
     	oControlModelGr = oDoc.createInstance("com.sun.star.form.component.GroupBox")
		oControlModelGr.Name = "グループボックス 1"
		oControlModelGr.Label = "GroupBox1"
		'
		oShapeGr.Control = oControlModelGr
		oSampleForm.insertByIndex( 0, oControlModelGr )
		oDoc.DrawPage.add( oShapeGr )
		oGroup.add( oShapeGr )
	' *******************
    '
    Dim oControlShape as Object
    Dim oControlModel as Object
 	Dim i as Integer
    	 For i = 0 To 5
        	' a shape
        	oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
        	positionShape( oControlShape, 1000, 1000 + i * 800, 5000, 600 )
        	' 
        	' a control model
        	oControlModel = createUnoService( "com.sun.star.form.component.RadioButton" )
        	oControlModel.Name = "Number"
        	oControlModel.Label = UCase( oList( i ) )
        	If i = 3 then
        		oControlModel.State = 1
        	End If
        	oControlModel.Tag = oList( i )
        	oSampleForm.insertByIndex( i, oControlModel )
        	'	 
        	' knit both
        	oControlShape.Control = oControlModel
        	' 
        	' add the shape to the DrawPage
        	oDoc.DrawPage.add( oControlShape )
     	Next i
     	'
	'
    ' set the focus to the first control
     	oDoc.CurrentController.getControl( oSampleForm.getByIndex( 0 ) ).setFocus
	'
	' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
	Dim oFrame as object
	Dim dispatcher as object
		oFrame   = oDoc.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
	Dim args1(0) as new com.sun.star.beans.PropertyValue
		args1(0).Name = "SwitchControlDesignMode"
		args1(0).Value = false
			dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
	'
	' 値の取得
	Dim oPForm as Object
	Dim oPFEltCount as Long
	Dim oPFElement as Object
	Dim oRButtonOnOff as Integer
	Dim oSelectItem as String
	Dim oDisp as String
		oPForm = oFormsCollection.getByIndex(0)
		oPFEltCount = oPForm.getCount()
		oDisp = ""
		for i = 0 to oPFEltCount - 1
			oPFElement = oPForm.getByIndex(i)
			If oPFElement.supportsService("com.sun.star.form.component.RadioButton") then
				oRButtonOnOff = oPFElement.State
				If oRButtonOnOff = 1 then
					oSelectItem = oPFElement.Label
					oDisp = oDisp & oSelectItem & Chr$(10)
				End If
			End If
		next i
	' Display
		msgbox(oDisp, 0, "GroupBox選択Item")
End Sub
'
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
	oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
	Dim oPos as new com.sun.star.awt.Point
    	oPos.X = X
     	oPos.Y = Y
     	oShape.setPosition( oPos )
     	Erase oPos
 	'
    Dim oSize as new com.sun.star.awt.Size
    	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
     	Erase oSize
End Sub

WFm-)[Writer]TextBox作成



Sub oGetPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     	'
     Dim oControlShape as Object
     Dim oControlModel as Object
 		'
        ' a shape
        oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
        oGetPositionShape( oControlShape, 1000, 1000 , 1500, 1000 )
         
        ' a control model
        ' Text Box
		oControlModel = oDoc.createInstance("com.sun.star.form.component.TextField")
		oControlModel.BackgroundColor = 14540253
		oControlModel.Border = 1
		oControlModel.DataField = "NAME"
		'
	' Dim oLControl(0) as New com.sun.star.beans.PropertyValue
	'	oLControl(0).Name = "Label"
	'	oLControl(0).Value = "Label_value"
		' oControlModel.LabelControl = oLControl		' Comment部を追加してもLabel Fieldの設定はされない。
		oControlModel.Name = "txtNAME"
		oControlModel.MultiLine = True
		oControlModel.Align = 0
		oControlModel.ReadOnly = false
		oControlModel.VScroll = true
		oControlModel.HScroll = true
		'
		oSampleForm.insertByIndex( 0, oControlModel )
		' Set Text
		oControlModel.String = "LibreOffice" & Chr$(10) & "Apache OpenOffice"
		'
		' knit both
         oControlShape.Control = oControlModel
        '
        ' add the shape to the DrawPage
        oDoc.DrawPage.add( oControlShape )
		'
		msgbox "Success"
End Sub
 
Sub oGetPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
     oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
     Dim oPos as new com.sun.star.awt.Point
     	oPos.X = X
     	oPos.Y = Y
     	oShape.setPosition( oPos )
     Erase oPos
 
     Dim oSize as new com.sun.star.awt.Size
     	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
     Erase oSize
End Sub

WFm-)[Writer]TextBox値取得



Sub oGetPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     	'
     Dim oControlShape as Object
     Dim oControlModel as Object
 		'
        ' a shape
        oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
        oGetPositionShape( oControlShape, 1000, 1000 , 5000, 600 )
         
        ' a control model
        ' Text Box
		oControlModel = oDoc.createInstance("com.sun.star.form.component.TextField")
		oControlModel.BackgroundColor = 14540253
		oControlModel.Border = 1
		oControlModel.DataField = "NAME"
		' REM oControlModel.LabelControl = oLControl
		oControlModel.Name = "txtNAME"
		oControlModel.MultiLine = True
		oControlModel.Align = 0
		oControlModel.ReadOnly = false
		'
		oSampleForm.insertByIndex( 0, oControlModel )
		' Set Text
		oControlModel.String = "LibreOffice Macro"
		'
		' knit both
         oControlShape.Control = oControlModel
        '
        ' add the shape to the DrawPage
        oDoc.DrawPage.add( oControlShape )
		'
		'
		' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
		Dim oFrame as object
		Dim dispatcher as object
			oFrame   = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
		Dim args1(0) as new com.sun.star.beans.PropertyValue
			args1(0).Name = "SwitchControlDesignMode"
			args1(0).Value = false
				dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
			'
		' 値の取得
		Dim oPForm as Object
		Dim oPFCtrlM as Object
		Dim oTextBoxName as String
		Dim oTextVal as String
		Dim oDisp as String
		Dim i as Integer
			oPForm = oFormsCollection.getByIndex(0)
			oPFCtrlM = oPForm.getControlModels()
			'  TextBoxの指定
			for i = 0 to UBound(oPFCtrlM)
				oTextBoxName = oPFCtrlM( i ).Name
				if oTextBoxName = "txtNAME" then
					' TextBox値取得
					oTextVal = oPFCtrlM( i ).Text
					' oTextVal = oPFCtrlM( i ).CurrentValue		'  こちらでも取得できる。
				End If
			next i
			'
			oDisp = "Text Boxの値 = " & oTextVal
		' Display
		msgbox(oDisp, 0, "TextBoxの値")
End Sub
'
Sub oGetPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
	oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
    Dim oPos as new com.sun.star.awt.Point
     	oPos.X = X
     	oPos.Y = Y
     	oShape.setPosition( oPos )
    Erase oPos
 	'
    Dim oSize as new com.sun.star.awt.Size
     	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
    Erase oSize
End Sub

WFm-)[Writer]TextBoxのControl変更



Sub oGetPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     	'
     Dim oControlShape as Object
     Dim oControlModel as Object
 		'
        ' a shape
        oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
        oGetPositionShape( oControlShape, 1000, 1000 , 3000, 2000 )
         
        ' a control model
        ' Text Box
		oControlModel = oDoc.createInstance("com.sun.star.form.component.TextField")
		oControlModel.BackgroundColor = 14540253
		oControlModel.Border = 1
		oControlModel.DataField = "NAME"
		' REM oControlModel.LabelControl = oLControl
		oControlModel.Name = "txtNAME"
		oControlModel.MultiLine = True
		oControlModel.Align = 0
		oControlModel.ReadOnly = false
		oControlModel.VScroll = true
		oControlModel.HScroll = true
		'
		oSampleForm.insertByIndex( 0, oControlModel )
		' Set Text
		oControlModel.String = "LibreOffice Macro"
		'
		' knit both
         oControlShape.Control = oControlModel
        '
        ' add the shape to the DrawPage
        oDoc.DrawPage.add( oControlShape )
		'
		'
		' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
		Dim oFrame as object
		Dim dispatcher as object
			oFrame   = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
		Dim args1(0) as new com.sun.star.beans.PropertyValue
			args1(0).Name = "SwitchControlDesignMode"
			args1(0).Value = false
			dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
			'
		' 値の取得
		Dim oPForm as Object
		Dim oPFCtrlM as Object
		Dim oTextBoxName as String
		Dim oTextVal as String
		Dim oDisp as String
		Dim i as Integer
			oPForm = oFormsCollection.getByIndex(0)
			oPFCtrlM = oPForm.getControlModels()
			'  TextBoxの指定
			for i = 0 to UBound(oPFCtrlM)
				oTextBoxName = oPFCtrlM( i ).Name
				if oTextBoxName = "txtNAME" then
					' TextBox値取得
					oTextVal = oPFCtrlM( i ).Text
					' oTextVal = oPFCtrlM( i ).CurrentValue		'  こちらでも取得できる。
				End If
			next i
			'
			oDisp = "Text Boxの値 = " & oTextVal
		' Display
		msgbox(oDisp, 0, "TextBoxの値")
		'
		' Text Box の Cntrol 値の変更
		args1(0).Name = "SwitchControlDesignMode"
		args1(0).Value = true
		dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
		'
		oPForm = oFormsCollection.getByIndex(0)
			oPFCtrlM = oPForm.getControlModels()
			'  TextBoxの指定
			for i = 0 to UBound(oPFCtrlM)
				oTextBoxName = oPFCtrlM( i ).Name
				if oTextBoxName = "txtNAME" then
					' Scroll Bar を非表示にする
					oPFCtrlM( i ).VScroll = false
					oPFCtrlM( i ).HScroll = false
				End If
			next i
			'
		args1(0).Name = "SwitchControlDesignMode"
		args1(0).Value = false
		dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
		'
		msgbox "Success"
End Sub
'
Sub oGetPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
	oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
    Dim oPos as new com.sun.star.awt.Point
     	oPos.X = X
     	oPos.Y = Y
     	oShape.setPosition( oPos )
    Erase oPos
 	'
    Dim oSize as new com.sun.star.awt.Size
     	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
    Erase oSize
End Sub

WFm-)[Writer]Command Button作成



Sub oPShapeControll
	Dim oDoc as Object
    	oDoc = ThisComponent
		' 
    ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     	'
     	'
     Dim oControlShape as Object
     Dim oControlModel as Object
 		'
        ' a shape
        oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
        positionShape( oControlShape, 1000, 1000 , 2000, 1000 )
        '
        ' a control model / Formを削除する時はFormを削除しても Control Modelは残るので、別途削除Codeが必要
        ' Command Bottun
		oControlModel = oDoc.createInstance("com.sun.star.form.component.CommandButton")
		oControlModel.Label     = "Push !!" 
   		oControlModel.Enabled   = True 
   		oControlModel.Printable = False 
   		oControlModel.Name      = "CmdBtn" 
   		oControlModel.Tag       = "CmdbtnTag" 
   		'
		' knit both
        oControlShape.Control = oControlModel
        '
        ' add the shape to the DrawPage
        oDoc.DrawPage.add( oControlShape )
        '
   		' Command Button にmacroを設定
   		Dim oMacroName as String
   		Dim oListener as Object
   		Dim oEvent as Object
   		Dim oForm as Object
   		Dim oId as Long
   			'
   			oMacroName = "oComandBtn"
    		'
    		oEvent = createUnoStruct("com.sun.star.script.ScriptEventDescriptor")
   			oEvent.ListenerType = "XActionListener" 
   			oEvent.EventMethod  = "actionPerformed" 
   			oEvent.ScriptType   = "Script" 
   			oEvent.ScriptCode   = "vnd.sun.star.script:Library1.Module1." & oMacroName & "?language=Basic&location=document" 
			'
			oForm = oDoc.DrawPage.getForms().getByIndex(0)
			oId = oForm.getCount() -1
			'
			oForm.registerScriptEvent(oId, oEvent) 
			'
			'
		' 念の為にCotrolDesignModeをOFFにする。(OOo3.2.1では不要、3.3Bataでは必要)
		Dim oFrame as object
		Dim dispatcher as object
			oFrame   = oDoc.CurrentController.Frame
			dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		Dim args1(0) as new com.sun.star.beans.PropertyValue
			args1(0).Name = "SwitchControlDesignMode"
			args1(0).Value = false
				dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
				'
		msgbox "Success"
 End Sub
 
Sub positionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
     oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
    Dim oPos as new com.sun.star.awt.Point
    	oPos.X = X
     	oPos.Y = Y
     	oShape.setPosition( oPos )
     	Erase oPos
 		'
    Dim oSize as new com.sun.star.awt.Size
     	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
     	Erase oSize
End Sub
'
Sub oComandBtn()
	msgbox "Command Botton" & Chr$(10) & "が押されました。",0,"Command Button"
End Sub
'
' [ 注意 ]
' 本Macro は document / Library1 / Module1 に 記述している。

WFm-)[Writer]RichTextBox作成



Sub oGetPShapeControll
	Dim oDoc as Object
    Dim Dummy()
    	oDoc = StarDesktop.LoadComponentFromURL( "private:factory/swriter", "_blank", 0, Dummy() )
	' 
     ' create a new logical form
	Dim oFormsCollection as Object
    	oFormsCollection = oDoc.DrawPage.Forms
    Dim oSampleForm as Object
    	oSampleForm = createUnoService( "com.sun.star.form.component.DataForm" )
    	oFormsCollection.insertByName( "sample form", oSampleForm )
     	'
     Dim oControlShape as Object
     Dim oControlModel as Object
 		'
        ' a shape
        oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
        oGetPositionShape( oControlShape, 1000, 1000 , 6000, 3000 )
         
        ' a control model
        ' Rich Text Box
		oControlModel = oDoc.createInstance("com.sun.star.form.component.RichTextControl")
		oControlModel.RichText = True
		oControlModel.BackgroundColor = 14540253
		oControlModel.Align = 0
		oControlModel.Border = 1
		REM oControlModel.DataField = "NAME_Rich"		' Data FieldとしてRich Textは無い。つまりBaseのFormには使えない？
		oControlModel.MultiLine = True
		oControlModel.Name = "rthNAME"
		oControlModel.ReadOnly = false
		'
		oSampleForm.insertByIndex( 0, oControlModel )
		' Set Text
		oControlModel.String = "[ Ritch Text Box ]"
		'
		' knit both
         oControlShape.Control = oControlModel
        ' add the shape to the DrawPage
        oDoc.DrawPage.add( oControlShape )
		'
		' a shape
        oControlShape = oDoc.createInstance( "com.sun.star.drawing.ControlShape" )
        oGetPositionShape( oControlShape, 1000, 5000 , 6000, 3000 )
         
        ' a control model
        ' Text Box
		oControlModel = oDoc.createInstance("com.sun.star.form.component.TextField")
		oControlModel.BackgroundColor = 14540253
		oControlModel.Align = 0
		oControlModel.Border = 1
		oControlModel.DataField = "NAME_Text"
		oControlModel.MultiLine = True
		oControlModel.Name = "txtNAME"
		oControlModel.ReadOnly = false
		'
		oSampleForm.insertByIndex( 0, oControlModel )
		' Set Text
		oControlModel.String = "[ Text Box ]"
		'
		' knit both
         oControlShape.Control = oControlModel
          ' add the shape to the DrawPage
        oDoc.DrawPage.add( oControlShape )
        '
        ' add the shape to the DrawPage
		msgbox "Success"
End Sub
 
Sub oGetPositionShape( oShape as Object, X as Integer, Y as Integer, Width as Integer, Height as Integer )
     oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
	'
     Dim oPos as new com.sun.star.awt.Point
     	oPos.X = X
     	oPos.Y = Y
     	oShape.setPosition( oPos )
     Erase oPos
 
     Dim oSize as new com.sun.star.awt.Size
     	oSize.Width = Width
     	oSize.Height = Height
     	oShape.setSize( oSize )
     Erase oSize
End Sub

WFm-)[Writer]Design mode ON/OFF(1)



Sub oFormDesignMode()
	Dim oDoc as Object
	Dim oCtrl as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		'
		if oCtrl.isFormDesignMode = false then
			oCtrl.setFormDesignMode(true)
			msgbox("Design Mode / ON",0,"Design Mode")
		else
			msgobx("既にDesign Modeです。",0,"Design Mode")
		end if
		'
		oCtrl.setFormDesignMode(false)
		msgbox("Design Mode / OFF",0,"Design Mode")
End Sub
'
' Messagebox の下のTool Barが変更している事で分る。

WFm-)[Writer]Design mode ON/OFF(2)



Sub oFormDesignMode()
	Dim oDoc as Object
	Dim oCtrl as Object
	Dim oFrame as Object
	Dim dispatcher as Object
	Dim args1(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame   = oCtrl.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		if oCtrl.isFormDesignMode = false then
			args1(0).Name = "SwitchControlDesignMode"
			args1(0).Value = true
			dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
			msgbox("Design Mode / ON( 2 )",0,"Design Mode")
		else
			msgobx("既にDesign Modeです。",0,"Design Mode")
		end if
		'
		args1(0).Name = "SwitchControlDesignMode"
		args1(0).Value = false
		dispatcher.executeDispatch(oFrame, ".uno:SwitchControlDesignMode", "", 0, args1())
		msgbox("Design Mode / OFF( 2 )",0,"Design Mode")
End Sub

WFm-)[Writer]

Draw[Writer]

WDw-)[Writer]Line


Sub oDrawInWriter
	Dim oDoc
	Dim oDrawPage
	Dim oShape
	Dim oDummy()
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter","_default", 0, oDummy)
		oDrawPage = oDoc.getDrawPage()
		' Drawing Start
			Dim oSize as new com.sun.star.awt.Size
			Dim oStepSize as Double
				oStepSize = 800
				for i = 0 to 10
					oShape = oDoc.createInstance("com.sun.star.drawing.LineShape")
					oShape.LineColor = RGB(255, 255-20*i, 20*i)
					oShape.LineWidth = 50
					oSize.Width = CLng(oStepSize /5 * i -oStepSize )
					oSize.Height = oStepSize
					oShape.setSize(oSize)
					oDrawPage.add(oShape)
				next i	
End Sub

DateTime[Writer]

WDaTm-)[Writer]現地時間入力



Sub oWriterFont
	Dim oDoc As Object
	Dim Dummy() 
  		On Error Goto oBad
		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
		oText = oDoc.getText()
		oVCurs = oDoc.CurrentController.getViewCursor()
    	oTCurs = oText.createTextCursorByRange(oVCurs.getStart())
    	oDisp = "What time is it now?" & Chr(10) & "It is "
    	oText.insertString(oTCurs, oDisp, FALSE)
		'
		oFormats = oDoc.getNumberFormats()
		'
		Dim oLanguage As New com.sun.star.lang.Locale
			oLanguage.Country = "ja"
  			oLanguage.Language = "JP"
  		oFormatNum = oFormats.queryKey ( "hh:mm:ss", oLanguage, TRUE)
		'
		oDateTime = oDoc.createInstance("com.sun.star.text.TextField.DateTime")
    	oDateTime.IsFixed = TRUE
    	'
    	oText.insertTextContent(oTCurs,oDateTime,FALSE)
		Exit Sub
	oBad:
		Dim oErLine As Integer
		Dim oErNum As Integer
		Dim oErMsg As String
			oErLine = Erl
			oErNum = Err
			oErMsg = Error
		Msgbox("Error Line No. " & Chr$(9) & " : " & oErLine & Chr$(10) _
			& "Error Number " & Chr$(9) & " : " & oErNum &Chr$(10 ) _
			& "Error Message" & Chr$(9) & " : " & oErMsg , 0, "Error Message")
End Sub

Annotation

WDw-)[Writer]



Sub WriterAddNoteAtCursor()
	Dim oDoc
  	Dim oViewCursor
  	Dim oCurs
  	Dim oTextField
  	Dim oDate As New com.sun.star.util.Date
  	Dim Dummy()
  		'
  		oDoc = StarDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, Dummy())
  		'
  	Dim oText as Object
  	Dim oSText as String
  		oText = oDoc.getText()
  		oSText = "Annotation(注記)"
  		oText.insertString(oText.getStart(), oSText , false)		'文頭
  		'
  		With oDate
    		.Day   = Day(Now - 10)
    		.Month = Month(Now - 10)
    		.Year  = Year(Now - 10)
  		End With
  		'
  		oViewCursor = oDoc.getCurrentController().getViewCursor()
  		oCurs=oText.createTextCursorByRange(oViewCursor.getStart())
  		' 
  		oTextField = oDoc.createInstance("com.sun.star.text.TextField.Annotation")
  		With oTextField
    		.Author  = "AP"
    		.Content = "It sure is fun to insert notes into my document"
    		.Date    = oDate
  		End With
  		'
  		oText.insertTextContent(oCurs, oTextField, False)
End Sub

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

Writer( 文書作成 )

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

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

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

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

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

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

WDPp-)[Writer]IndexAutoMarkFileURL

WDPp-)[Writer]WordSeparator

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

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

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

WDF-)[Writer]文字Font

WDF-)[Writer]Itaric

WDF-)[Writer]OBLIQUE

WDF-)[Writer]REVERSE_ITALIC

WDF-)[Writer]REVERSE_OBLIQUE

WDF-)[Writer]BOLD

WDF-)[Writer]SEMIBOLD

WDF-)[Writer]ULTRABOLD

WDF-)[Writer]BLACK

WDF-)[Writer]THIN

WDF-)[Writer]ULTRALIGHT

WDF-)[Writer]LIGHT

WDF-)[Writer]SEMILIGHT

WDF-)[Writer]SINGLE(下線)

WDF-)[Writer]DOUBLE(下線)

WDF-)[Writer]DOTTED

WDF-)[Writer]DASH

WDF-)[Writer]LONGDASH

WDF-)[Writer]DASHDOT

WDF-)[Writer]DASHDOTDOT

WDF-)[Writer]SMALLWAVE

WDF-)[Writer]WAVE

WDF-)[Writer]DOUBLEWAVE

WDF-)[Writer]BOLD

WDF-)[Writer]BOLDDOTTED

WDF-)[Writer]BOLDDASH

WDF-)[Writer]BOLDLONGDASH

WDF-)[Writer]BOLDDASHDOT

WDF-)[Writer]BOLDDASHDOTDOT

WDF-)[Writer]BOLDWAVE

WDF-)[Writer]下線色

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

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

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

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

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

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

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

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

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

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

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

WDF-)[Writer]CaseMap1

WDF-)[Writer]CaseMap2

WDF-)[Writer]CaseMap3

WDF-)[Writer]CaseMap4

WDF-)[Writer]点滅

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

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

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

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

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

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

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

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

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

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

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

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

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

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

WDF-)[Writer]Auto Kerning

WDF-)[Writer]背景色

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

WDF-)[Writer]Font Style

WDF-)[Writer]Font Name

WDF-)[Writer]CharFontNameComplex

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

【 Index 】

【 Macro Code 】