Macroの杜
(LibreOffice Basic編)

< 前 Calc No.1 次 >

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

Cell操作


[ 取得・代入 ]


[ Insert･Delete ]


[ Copy ]


[ Property(Cellの書式設定) ]


{{ Format }}


{{ Font }}

{{ Font Effet }}[ Refer to "Font / 文字関連の Property 一覧" ]


{{ Position / Size }}


{{ BorderLine }}


{{ Protection }}


{{ Color }}


{{ autoFormat }}


{{ Annotation( Comment ) }}


[ Claer(内容の削除) ]


[ Selection ]


[ Address(セル番地) ]



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


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

Cell操作


[ 値の代入、取得のコードは上部に移動 ]


[ Cellの挿入・削除のコードは上部に移動 ]


[ Copy ]

CCI-)[Calc]CellのCOPY

Sub oCopyRange
	Dim oSHeet
	Dim oRangeAddress
	Dim oCellAddress
		oSheet = ThisComponent.Sheets(1)
		oRangeAddress = oSheet.getCellRangeByName("A1:B5").getRangeAddress()
		oCellAddress = oSheet.getCellByPosition(2,0).getCellAddress()
	oSheet.copyRange(oCellAddress, oRangeAddress)
End SUb

CCI-)[Calc]CellのCOPY2

Sub oCopyData
	Dim oDoc as Object
	Dim oSheet1, oSheet2 as Object
	Dim oCopyData as Object
	Dim oCopyRange as Object
	Dim oPasteRange as Object
	Dim sCol, eCol as Long
	Dim sRow, eRow as Long
		oDoc = ThisComponent
		oSheet1 = oDoc.getSheets().getByIndex(0)
		oSheet2 = oDoc.getSheets().getByIndex(1)
		sCol = 0
		eCol = 10
		sRow = 0
		eRow = 100
		oCopyRange = oSheet1.getCellRangeByPosition(sCol, sRow, eCol, eRow)
		oPasteRange = oSheet2.getCellRangeByPosition(sCol, sRow, eCol, eRow)
		oCopyData = oCopyRange.getData()
		oPasteRange.setData(oCopyData)
End Sub

CCI-)[Calc]Cell範囲のCOPY3

Sub oCopyData
	Dim oDoc as Object
	Dim oSheet1, oSheet2 as Object
	Dim oCopyData as Object
	Dim oCopyRange as Object
	Dim oPasteRange as Object
	Dim sCol, eCol as Long
	Dim sRow, eRow as Long
		oDoc = ThisComponent
		oSheet1 = oDoc.getSheets().getByIndex(0)
		oSheet2 = oDoc.getSheets().getByIndex(1)
		sCol = 0
		eCol = 10
		sRow = 0
		eRow = 100
		oCopyRange = oSheet1.getCellRangeByPosition(sCol, sRow, eCol, eRow)
		oPasteRange = oSheet2.getCellRangeByPosition(sCol, sRow, eCol, eRow)
		oCopyData = oCopyRange.getDataArray()
		oPasteRange.setDataArray(oCopyData)
End Sub

CCI-)[Calc]形式を選択して貼り付け

Sub CopyPaste
	Dim oFrame   as object
	Dim dispatcher as object
		'
		oFrame   = ThisComponent.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		dispatcher.executeDispatch(oFrame, ".uno:Copy", "", 0, Array())
		'
	Dim oArgs2(0) as new com.sun.star.beans.PropertyValue
		oArgs2(0).Name = "ToPoint"
		oArgs2(0).Value = "$B$5"
		dispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oArgs2())
		'
	Dim oArgs3(5) as new com.sun.star.beans.PropertyValue
		oArgs3(0).Name = "Flags"
		oArgs3(0).Value = "SDFNT"			' ← 下記" Flag Value "参照
		oArgs3(1).Name = "FormulaCommand"
		oArgs3(1).Value = 0
		oArgs3(2).Name = "SkipEmptyCells"
		oArgs3(2).Value = false
		oArgs3(3).Name = "Transpose"
		oArgs3(3).Value = false
		oArgs3(4).Name = "AsLink"
		oArgs3(4).Value = false
		oArgs3(5).Name = "MoveMode"
		oArgs3(5).Value = 4
		dispatcher.executeDispatch(oFrame, ".uno:InsertContents", "", 0, oArgs3())
		'
	msgbox "Success"
End Sub
'
' [ Flag Value ]
' S    : String ( テキスト ) 
' V    : Value ( 値 )
' D    : Date ( 日付 )
' F    : Formula ( 式 )
' N    : Note ( コメント )
' T    : Format ( 書式 )
' 空白 : Object ( オブジェクト )
' A    : 全て

CCI-)[Calc]別のDocumentにCopy

実行結果
Sub Test()
	Dim oDoc as Object, oDoc2 as Object
	Dim oSheet as Object, oSheet2 as Object
	Dim oCell as Object, oCell2 as Object
	Dim oCopyRange as Object, oPasteRange as Object
	Dim oCopyData as Object
		'元のDocumentの設定
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("Sheet1")
		'
		'コピー先Documentの設定
		oDoc2 = oWorkBook("GetComponent.ods")
		IF IsNull(oDoc2) Then
			msgbox "Copy先のDocumentは開かれていません"
   			Exit Sub
		End IF
		oSheet2 = oDoc2.getSheets().getByName("Sheet1")
		'
		oCopyRange = oSheet.getCellRangeByName("A2:A4")
		oPasteRange = oSheet2.getCellRangeByName("A2:A4")
		'元のDocumentからｺﾋﾟｰ先に値をｺﾋﾟｰ
		oCopyData = oCopyRange.getDataArray()
		oPasteRange.setDataArray(oCopyData)		' ※：式は値でコピーされる
		'
		'式をコピーする場合
		oSheet2.getCellRangeByName("A5").Formula = oSheet.getCellRangeByName("A4").Formula
		msgbox "Success", 0, "LO7.0.4.2"
End Sub

Function oWorkBook(filename As string) As Object
	Dim oComponents as Object, oEnum as Object
	Dim oComponent as Object
		oComponents = StarDesktop.getComponents
		oEnum = oComponents.createEnumeration()
		While oEnum.hasMoreElements()
		oComponent = oEnum.nextElement()
		IF oComponent.haslocation then
			IF Dir(oComponent.location) = fileName Then
				oWorkBook = oComponent
				Exit Function
			End IF
		End IF   
		Wend
		oWorkBook = Nothing
End Function


[ Property(Cellの書式設定) ]

CCProp-)[Calc]直接設定した書式の解除

Sub CellProtect()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch(oFrame, ".uno:ResetAttributes", "", 0, Array())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
実行結果実行結果


{{ Format }}

CCF-)[Calc]セルの表示形式キーNo.取得


Sub NumFormatNo()
	Dim oDoc as Object
	Dim oNumberFormats As Object
	Dim oLocale As New com.sun.star.lang.Locale
	Dim oDF(12) as String
	Dim oKeyNo(12) as Long
		oLocale.Language = "ja"
		oLocale.Country = "JP"
		oDoc = ThisComponent
		oNumberFormats = oDoc.NumberFormats
			oDF(0) = "#,##0"
			oDF(1) = "#,##0.#0"
			oDF(2) = "0%"
			oDF(3) = "0.00%"
			oDF(4) = "[$￥-411]#,##0;-[$￥-411]#,##0"
			oDF(5) = "[$￥-411]#,##0;[RED]-[$￥-411]#,##0"
			oDF(6) = "YYYY/MM/DD"
			oDF(7) = "YYYY年MM月DD日(AAAA)"	
			oDF(8) = "GE.M.D"
			oDF(9) = "HH:MM"
			oDF(10) = "HH:MM:SS"
			oDF(11) = "0.00E+00"
			oDF(12) = "# ??/??"
			'
		oDisp = "[ Number ] " & Chr$(10)
			for i = 0 to 1
				oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
				oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
			next i
			oDisp = oDisp & Chr$(10)
			'
		oDisp = oDisp & "[ Percent ]" & Chr$(10)
			for i = 2 to 3
				oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
				oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
			next i
			oDisp = oDisp & Chr$(10)
			'
		oDisp = oDisp & "[ Current ]" & Chr$(10)
			for i = 4 to 5
				oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
				oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
			next i
			oDisp = oDisp & Chr$(10)
			'
		oDisp = oDisp & "[ Date ]" & Chr$(10)
			for i = 6 to 8
				oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
				oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
			next i
			oDisp = oDisp & Chr$(10)
			'	
		oDisp = oDisp & "[ Time ]" & Chr$(10)
			for i = 9 to 10
				oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
					oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
			next i
			oDisp = oDisp & Chr$(10)
			'
		oDisp = oDisp & "[ 指数 ]" & Chr$(10)
			for i = 11 to 11
				oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
				oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
			next i
			oDisp = oDisp & Chr$(10)
			'
		oDisp = oDisp & "[ 分数 ]" & Chr$(10)
			for i = 12 to 12
				oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
				oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
			next i
			'
	MsgBox(oDisp, 0,"表示ｷｰNo.") 
End Sub

CCF-)[Calc]セル数値の表示形式を設定1

Sub NumberFmt()
	Dim oDoc as Object
	Dim oSheet　as Object
	Dim NumberFormats As Object
	Dim NumberFormatString As String
	Dim NumberFormatId As Long
	Dim LocalSettings As New com.sun.star.lang.Locale
		'
		oDoc=ThisComponent
		oSheet=oDoc.getSheets().getByName("sheet1")
		oCell=oSheet.getCellByPosition(1,1)		'←設定範囲
		NumberFormats = oDoc.NumberFormats
		NumberFormatString = "#,##0.#0円"
 		'
		NumberFormatId = NumberFormats.queryKey(NumberFormatString, LocalSettings, True)
		If NumberFormatId = -1 Then
   			NumberFormatId = NumberFormats.addNew(NumberFormatString, LocalSettings)	'書式コードを追加
		End If
		oCell.NumberFormat = NumberFormatId
		'
		msgbox "Success"
End Sub

CCF-)[Calc]セル数値の表示形式を設定2

Sub SetNumFormat()
	Dim oNumberFormats As Object
	Dim oLocale As New com.sun.star.lang.Locale
		oLocale.Language = "ja"
		oLocale.Country = "JP"
			oDoc = ThisComponent
			oSheet = oDoc.getSheets.getByIndex(0)
			oCell = oSheet.getCellByPosition(0,0)
		oCell.value = 10000
	oCell.NumberFormat = 5103
End Sub

CCF-)[Calc]セル数値の表示形式を設定3

Sub UnoNumFmt()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "B2"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
		oProp(0).Name = "NumberFormatValue"
		oProp(0).Value = 103
		oDispatcher.executeDispatch(oFrame, ".uno:NumberFormatValue", "", 0, oProp())
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
'
' [ Note ]
1)	Standard	= 0

{ 数字 }
2)	0		= 1
3)	0.00		= 2
4)	#,##0		= 3
5)	#,##0.00	= 4
6)	#,###.00	= 5

{ Percent }
7)	0%		= 10
8)	0.00%		= 11

{ 通貨 }
9)	[$￥-411]#,##0;-[$￥-411]#,##0			= 101
10)	[$￥-411]#,##0.00;-[$￥-411]#,##0.00		= 103
11)	[$￥-411]#,##0;[RED]-[$￥-411]#,##0		= 103
12)	[$￥-411]#,##0.00;[RED]-[$￥-411]#,##0.00	= 104
13)	[$￥-411]#,##0.--;[RED]-[$￥-411]#,##0.--	= 105
14)	#,##0 [$JPY];[RED]-#,##0 [$JPY]			= 110
15)	￥#,##0;-￥#,##0				= 111
16)	￥#,##0.00;-￥#,##0.00				= 20
17)	￥#,##0;[RED]-￥#,##0				= 21
18)	￥#,##0.00;[RED]-￥#,##0.00			= 22
19)	#,##0 CCC					= 24
20)	￥#,##0.--;[RED]-￥#,##0.--			= 25

{ 日付 }
21)	YY/M/D			= 30
22)	YYYY年MM月DD日（AAAA）	= 38
23)	YY/MM/DD		= 37
24)	YYYY/MM/DD		= 36
25)	YY年M月D日		= 39
26)	YYYY年M月D日		= 75
27)	GGGE年M月D日		= 80
28)	YYYY年M月D日		= 76
29)	GGGE年M月D日（AAAA）	= 81
30)	YY年M月D日（AAA）	= 77
31)	GGGE年M月D日（AAA）	= 31
32)	YYYY年M月D日（AAA）	= 78
33)	YYYY年M月D日（AAAA）	= 79
34)	MM.DD			= 82
35)	GE.M.D			= 83
36)	YYYY-MM-DD		= 84
37)	YY/MM			= 32
38)	M月D日			= 33
39)	M月			= 34
40)	YY年 QQ			= 35
41)	WW			= 85

{ 時刻 }
42)	YY/MM/DD HH:MM		= 50
43)	YYYY/M/D H:MM		= 51
44)	H:MM			= 40
45)	HH:MM:SS		= 41
46)	AM/PM H:MM		= 42
47)	AM/PM H:MM:SS		= 43
48)	[HH]:MM:SS		= 44
49)	MM:SS.00		= 45
50)	[HH]:MM:SS.00		= 46
51)	YY/MM/DD HH:MM		= 50
52)	YYYY/M/D H:MM		= 51

{ 指数 }
53)	0.00E+000	= 60
54)	0.00E+00	= 61

{ 分数 }
55)	# ?/?		= 70
56)	# ??/??		= 71

{ プール値 }
57)	BOOLEAN		= 99

{ テキスト }
58)	@		= 100

CCF-)[Calc]Content Type of Cell

Sub oContentType()
	Dim oDoc
	Dim oSheets
	Dim oCell
		oDoc = ThisComponent
		oSheets = oDoc.Sheets(0)
		oCell = oSheets.getCellByPosition(1,2)
		oType = oCell.getType()
		Select Case oType
			case com.sun.star.table.CellContentType.EMPTY
				oDisp = "Empty"
			case com.sun.star.table.CellContentType.VALUE
				oDisp = "Value"
			case com.sun.star.table.CellContentType.TEXT
				oDisp = "Text"
			case com.sun.star.table.CellContentType.FORMULA
				oDisp = "Formula"
			case Else
				oDisp = "UnKnown"
		End Select
	msgbox(oDisp,0,"com.sun.star.table.CellContentType")
End SUb

CCF-)[Calc]User Defined Attributes

Sub oCellPropertiesService()
	Dim oSheets
	Dim oCell
	Dim oUserData
	Dim oUserAttr as new com.sun.star.xml.AttributeData
		oSheets = ThisComponent.Sheets(1)
		oCell =oSheets.getCellByPosition(0,0)
		'xray oUserAtrr
		oUserAttr.Type ="CDATA"
		oUserAttr.Value = "NewOOo3 macro"
		oUserData = oCell.UserDefinedAttributes
		If NOT oUserData.hasByName("home") then
			oUserData.insertByName("home",oUserAttr)
			oCell.UserDefinedAttributes = oUserData
		End If
		'xray oUserData
		oUser = oUserData.ElementNames
		for i= 0 to UBound(oUser)
			oDisp =oDisp & oUser(i) & Chr$(10)
		next i
	msgbox(oDisp,0,"UserDefinedAtrributes")
End Sub

CCF-)[Calc]固有Format Range

Sub oDisplaySimilarRange
	Dim oSheetUniqueRange
	Dim oSheetCellRange
	Dim oAddress
	Dim oGetFormat
	Dim oSheet
		oSheet = ThisComponent.Sheets(1)
	'getCellFormatRanges()
		oGetFormat = oSheet.getCellFormatRanges()
		oDisp = "[   getCellFormatRanges()  ]" & Chr$(10)
		for i= 0 to oGetFormat.getCount-1
			oSheetCellRange = oGetFormat.getByIndex(i)
			oAddress = oSheetCellRange.getRangeAddress()
			oDisp = oDisp & Chr$(9) & Chr$(9) & _
						 i & " = Sheet" & (oAddress.Sheet +1) & "." & _
						ColumnNumberToString(oAddress.StartColumn) & (oAddress.StartRow + 1) & _
						":" & _
						ColumnNumberToString(oAddress.EndColumn) & (oAddress.EndRow + 1) & _
						Chr$(10)
		next i 
		oDisp =oDisp & Chr$(10)
	'
	'getUniqueCellFormatRanges()
		oGetFormat = oSheet.getUniqueCellFormatRanges()
		oDisp = oDisp & "[  getUniqueCellFormatRanges()  ]" & Chr$(10)
		for i= 0 to oGetFormat.getCount-1
			 oSheetUniqueRange = oGetFormat.getByIndex(i)
			 oDisp = oDisp & Chr$(9) & Chr$(9) & _
						 i & " = " & oSheetUniqueRange.getRangeAddressesAsString() & _
						 Chr$(10)
		next i 
	'Display
	msgbox(oDisp , 0, "Like Range")	
End Sub

'[ Function2 ]
Function ColumnNumberToString(ByVal nColumn As Long) as String
	Dim oReturn2 as String
	Do While nColumn>=0
		oReturn2= Chr$(65+ (nColumn MOD 26)) & oReturn2
		nColumn= nColumn / 26 -1
	Loop
	ColumnNumberToString = oReturn2
End Function

CCF-)[Calc]Cellの書式設定Dialog表示


Sub CellFormatMacro()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatch as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatch = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatch.executeDispatch(oFrame, ".uno:FormatCellDialog", "", 0, Array())
		msgbox "Success"
End Sub


{{ Font }}

CCFo-)[Calc]Cell幅に合わせて改行(1)


Sub oWrapping()
	Dim oDoc As Object
	Dim oSheet as Object
	Dim oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,0)
		oCell.String = "LibreOffice / ApacheOpenOffice マクロマニュアル"
		oCell.IsTextWrapped = True
	msgbox "Success"
End Sub

CCFo-)[Calc]Cell幅に合わせて改行(2)


Sub CalcUnoFont()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		'
		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByName("sheet1")
  		oCell = oSheet.getCellRangeByName("A1")
		oCell.String = "LibreOffice / ApacheOpenOffice マクロマニュアル(DispatchHelper)"
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A1"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			oProp(0).Name = "WrapText"
			oProp(0).Value = true
		oDispatcher.executeDispatch(oFrame, ".uno:WrapText", "", 0, oProp())
		'
		msgbox "Success"
End Sub

CCFo-)[Calc]文字関連の Property 一覧


Sub CellPropertyList()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oTextCursor as Object
		oDoc=ThisComponent
		oSheet=oDoc.getSheets().getByindex(0)
		oCell=oSheet.getCellByPosition(0,1)
		oCell.String="水 素はH2"
		' cell全体の設定
		with oCell
			.CharFontName = "Arial"
			.CharFontNameAsian = "Arial"
			.CharPosture = com.sun.star.awt.FontSlant.ITALIC
			.CharPostureAsian = com.sun.star.awt.FontSlant.OBLIQUE
			.CharHeight=40				'英数字サイズは40(Cell単位での設定)
			.CharHeightAsian=20			'日本語は20(Cell単位での設定)
		end with
		'
		' Versionによっては Cell に値が無い状態で createTextCursor() を行うとCrashする
		if Trim(oCell.String)="" then
			oDisp = "Cellが空白です。" & Chr$(10) & "VersionによってはCrashする可能性があります。" & Chr$(10) & "処理を続けますか?"
			oAns = msgbox(oDisp, 0,"Caution")
			if oAns <> 6 then
				Exit Sub
			end if
		end if
		' Cellの一部の設定
		oTextCursor = oCell.createTextCursor()
		With oTextCursor
    		.gotoStart( False )
    		.goRight(3 , True )
    		.setPropertyValue( "CharContoured", true )　				'中抜き効果
    		.setPropertyValue( "CharCrossedOut", true ) 				'取り消し線	
    		.setPropertyValue( "CharStrikeout", 2 ) 					'取り消し線の種類	 		
    		.setPropertyValue("CharEmphasis",3)							'強調文字 3は「・」の上付き、4は「、」の上付
    		.setPropertyValue("CharWordMode",false)						'空白に下線や取消線を適用しない / false ⇒ 適用する
    		.setPropertyValue("CharUnderlineColor", 2918503 )		' 下線色 / 白抜きにしているので無意味
    		.setPropertyValue("CharUnderline",1)						'UnderLine
    		.setPropertyValue("CharRelief",1)							'浮き出し　０はNormal　1は浮き出し効果
    		.setPropertyValue("CharShadowed",true)						'Shadow効果
    		.gotoEnd( False )
    	End with
    msgbox "Success"
End Sub

CCFo-)[Calc]文字列の右1文字を下付文字にする


Sub CellFont()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCell as Object
	Dim oTextCursor as Object
	Dim oDisp as String
	Dim oAns as Long
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,1)
		oCell.String = "水素はH2"
		'
		' Versionによっては Cell に値が無い状態で createTextCursor() を行うとCrashする
		if Trim(oCell.String)="" then
			oDisp = "Cellが空白です。" & Chr$(10) & "VersionによってはCrashする可能性があります。" & Chr$(10) & "処理を続けますか?"
			oAns = msgbox(oDisp, 0,"Caution")
			if oAns <> 6 then
				Exit Sub
			end if
		end if
		'
		oTextCursor = oCell.createTextCursor()
		With oTextCursor
    		.gotoStart( False )
    		.gotoEnd( False )
    		.goLeft(1 , True )
    		.setPropertyValue( "CharEscapement", -101 ) 	'←下付は「-101」
    		.setPropertyValue( "CharEscapementHeight", 80 )	'←下付文字のサイズは80%としている。
    	End with
    	msgbox "Success"
End Sub

CCFo-)[Calc]Cell背景(1)


Sub BackColorOfCell()
	Dim oDoc as Object, oSheet as Object
	Dim oCellRange as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCellRange = oSheet.getCellRangeByName("A1:A2")
		oCellRange.CellBackColor = RGB(0,255,0)
		msgbox "Change Back Color!!",0,"Cell"
		' A1 Cellの背景を削除する。(元に戻す)
		oCell = oSheet.getCellRangeByName("A1")
		oCell.CellBackColor = -1
		msgbox "Remove Back Color!!",0,"Cell"
End Sub

CCFo-)[Calc]Cell背景(2)


Sub UnoCellBackColor()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A1"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
		oProp(0).Name = "BackgroundPattern.BackColor"
		oProp(0).Value = &H00FF00
		oDispatcher.executeDispatch(oFrame, ".uno:BackgroundPattern", "", 0, oProp())
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCFo-)[Calc]文字の角度(1)


Sub CellPropertiesSrv()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCell(5) as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 5
			oCell(i) = oSheet.getCellByPosition(0,i)
			oCell(i).String = "A"
		next i
		' 
		oCell(0).RotateAngle = 2000		'20degree
		oCell(1).RotateAngle = 4000
		oCell(2).RotateAngle = 6000
		oCell(3).RotateAngle = 9000
		oCell(4).RotateAngle = -4500
		oCell(5).RotateAngle = -9000
	msgbox("Success")
End Sub

CCFo-)[Calc]文字の角度(2)


Sub CellPropertiesSrv()
	Dim oDoc as Object, oSheet as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oCell(5) as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 3
			oCell(i) = oSheet.getCellByPosition(0,i)
			oCell(i).String = "A"
		next i
		' 
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Standard
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A1"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oProp(0).Name = "AlignmentRotationMode"
		oProp(0).Value = com.sun.star.table.CellVertJustify.STANDARD
		oDispatcher.executeDispatch(oFrame, ".uno:AlignmentRotationMode", "", 0, oProp())
		oProp(0).Name = "AlignmentRotation"
		oProp(0).Value = 6000			' 60 degree
		oDispatcher.executeDispatch(oFrame, ".uno:AlignmentRotation", "", 0, oProp())
		'
		' Cell の上縁を基準に傾ける
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A2"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oProp(0).Name = "AlignmentRotationMode"
		oProp(0).Value = com.sun.star.table.CellVertJustify.TOP
		oDispatcher.executeDispatch(oFrame, ".uno:AlignmentRotationMode", "", 0, oProp())
		oProp(0).Name = "AlignmentRotation"
		oProp(0).Value = 6000			' 60 degree
		oDispatcher.executeDispatch(oFrame, ".uno:AlignmentRotation", "", 0, oProp())
		'
		' Cell の下縁を基準に傾ける 
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A3"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oProp(0).Name = "AlignmentRotationMode"
		oProp(0).Value = com.sun.star.table.CellVertJustify.BOTTOM
		oDispatcher.executeDispatch(oFrame, ".uno:AlignmentRotationMode", "", 0, oProp())
		oProp(0).Name = "AlignmentRotation"
		oProp(0).Value = 6000			' 60 degree
		oDispatcher.executeDispatch(oFrame, ".uno:AlignmentRotation", "", 0, oProp())
		
	msgbox("Success")
End Sub

CCFo-)[Calc]Font Weight


Sub CellFontWeight()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,0)
		With oCell
			.String = "LibreOffice / Apache OpenOffice"
			.CharWeight = com.sun.star.awt.FontWeight.BOLD
		End With
	msgbox("Success")
End Sub

CCFo-)[Calc]縦書き(1)


Sub CellPropertiesSrv()
	Dim oDoc as Object, oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellRangeByName("A1")
		oCell.String = "こんにちは。" & Chr$(10) & "LO Ver4.2.4" & Chr$(13) & _
							"6月３日" & Chr$(10) & "( ３は全角 )" 
		oCell.Orientation = 3
		oCell.AsianVerticalMode = True
		'
	msgbox "Success",0,"縦書き"
End Sub

CCFo-)[Calc]縦書き(2)


Sub CellPropertiesSrv()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellRangeByName("A1")
		oCell.String = "こんにちは。" & Chr$(10) & "LO Ver4" & Chr$(13) & _
							"5月８日" & Chr$(10) & "( ８は全角 )" 
		' 
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Standard
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A1"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame, ".uno:TextdirectionTopToBottom", "", 0, Array())
		'
	msgbox("Success")
End Sub

{{ Font Effet }}

CCFe-)[Calc]各種UnderLine設定


Sub CalcUnderLine()
	Dim oDoc As Object, oSheet as Object
	Dim oCell(18) as Object
		oDoc=ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i=0 to 9
			oCell(i) = oSheet.getCellByPosition(0,i)
			oCell(i).String= i & ")  LibreOffice" 
		next i
		for i = 10 to 18
			oCell(i) = oSheet.getCellByPosition(1, i - 10 )
			oCell(i).String= i & ")  Apache OpenOffice"
		next i
		oCell(0).CharUnderline = com.sun.star.awt.FontUnderline.NONE
		oCell(1).CharUnderline = com.sun.star.awt.FontUnderline.SINGLE
		oCell(2).CharUnderline = com.sun.star.awt.FontUnderline.DOUBLE
		oCell(3).CharUnderline = com.sun.star.awt.FontUnderline.DOTTED
		oCell(4).CharUnderline = com.sun.star.awt.FontUnderline.DONTKNOW
		oCell(5).CharUnderline = com.sun.star.awt.FontUnderline.DASH
		oCell(6).CharUnderline = com.sun.star.awt.FontUnderline.LONGDASH
		oCell(7).CharUnderline = com.sun.star.awt.FontUnderline.DASHDOT
		oCell(8).CharUnderline = com.sun.star.awt.FontUnderline.DASHDOTDOT
		oCell(9).CharUnderline = com.sun.star.awt.FontUnderline.SMALLWAVE
		oCell(10).CharUnderline = com.sun.star.awt.FontUnderline.WAVE
		oCell(11).CharUnderline = com.sun.star.awt.FontUnderline.DOUBLEWAVE
		oCell(12).CharUnderline = com.sun.star.awt.FontUnderline.BOLD
		oCell(13).CharUnderline = com.sun.star.awt.FontUnderline.BOLDDOTTED
		oCell(14).CharUnderline = com.sun.star.awt.FontUnderline.BOLDDASH
		oCell(15).CharUnderline = com.sun.star.awt.FontUnderline.BOLDLONGDASH
		oCell(16).CharUnderline = com.sun.star.awt.FontUnderline.BOLDDASHDOT
		oCell(17).CharUnderline = com.sun.star.awt.FontUnderline.BOLDDASHDOTDOT
		oCell(18).CharUnderline = com.sun.star.awt.FontUnderline.BOLDWAVE
		msgbox "Success"
End Sub

CCFe-)[Calc]下線色 / Color of Underline


Sub FontEffect()
	Dim oDoc as Object, oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,0)
		oCell.String = "LibreOffice"
		' Font Effect
		with oCell
			.CharHeight = 20
			.CharHeightAsian = 20
			.CharUnderline = com.sun.star.awt.FontUnderline.DOUBLE
   			.CharUnderlineColor = RGB(255,0,0) 						' Color of the Underline of Font
   			.CharUnderlineHasColor = true
		end with	
		msgbox "Success"
End Sub

CCFe-)[Calc]各種UnderLineと下線色


Sub CalcUnoFont()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oPreProp(0) as new com.sun.star.beans.PropertyValue
	Dim oProp(2) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByName("sheet1")
  		oCell = oSheet.getCellRangeByName("A1")
		oCell.String = "LibreOffficeです"
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			' A1 Cellへ移動
			oPreProp(0).Name = "ToPoint"
			oPreProp(0).Value = "A1"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oPreProp())
			' Under line
			oProp(0).Name = "Underline.LineStyle"
			oProp(0).Value = com.sun.star.awt.FontUnderline.WAVE		' = 10
			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())
		msgbox "Success"
End Sub

CCFe-)[Calc]ドット / 2重線 / 1重線のUnderLine

Sub CalcUnoFont()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oPreProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByName("sheet1")
  		oCell = oSheet.getCellRangeByName("A1")
		oCell.String = "LibreOffficeです(2)"
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			' A1 Cellへ移動
			oPreProp(0).Name = "ToPoint"
			oPreProp(0).Value = "A1"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oPreProp())
		' [ Under line ]
		' Dot
		oDispatcher.executeDispatch(oFrame, ".uno:UnderlineDotted", "", 0, Array())
		msgbox "Dotted(ドット下線)",0,"下線"
		' Under line削除 / 同じCommandを続けると削除される。
		oDispatcher.executeDispatch(oFrame, ".uno:UnderlineDotted", "", 0, Array())
		msgbox "Dotted(ドット下線)削除",0,"下線"
		' Double
		oDispatcher.executeDispatch(oFrame, ".uno:UnderlineDouble", "", 0, Array())
		msgbox "Double(2重線)",0,"下線"
		' Single
		oDispatcher.executeDispatch(oFrame, ".uno:UnderlineSingle", "", 0, Array())
		msgbox "Single(1重線)",0,"下線"
		' None
		oDispatcher.executeDispatch(oFrame, ".uno:UnderlineNone", "", 0, Array())
		msgbox "None(下線無し)",0,"下線"		
End Sub

CCFe-)[Calc]影付き文字(1)


Sub FontEffect()
	Dim oDoc as Object, oSheet as Object, oCell as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,0)
		oCell.String = "LO ( 影付き )"
		' Font Effect
		with oCell
			.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	
		msgbox "Success"
End Sub

CCFe-)[Calc]影付き文字(2)


Sub CalcUnoFont()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByName("sheet1")
  		oCell = oSheet.getCellRangeByName("A1")
		oCell.String = "OSSでいこう"
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			' A1 Cellへ移動
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A1"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			' Under line
			oProp(0).Name = "Shadowed"
			oProp(0).Value = true
		oDispatcher.executeDispatch(oFrame, ".uno:Shadowed", "", 0, oProp())
		msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCFe-)[Calc]各種取消し線(1)


Sub FontEffect()
	Dim oDoc as Object, oSheet as Object, oCell  as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Font Effect
		for i = 0 to 5
			oCell = oSheet.getCellByPosition(0,i)
			oCell.String = "LibreOfficeです"
			with oCell
				.CharHeight  = 20
				.CharHeightAsian = 20	
			end with	
			' Strikeouot
			select case i
				case 0
					oCell.CharStrikeout = com.sun.star.awt.FontStrikeout.NONE		' 無し( = com.sun.star.awt.FontStrikeout.DONTKNOW )
				case 1
					oCell.CharStrikeout = com.sun.star.awt.FontStrikeout.SINGLE		' 一重線
				case 2
					oCell.CharStrikeout = com.sun.star.awt.FontStrikeout.DOUBLE	' 二重線
				case 3
					oCell.CharStrikeout = com.sun.star.awt.FontStrikeout.BOLD		' 太線
				case 4
					oCell.CharStrikeout = com.sun.star.awt.FontStrikeout.SLASH		' 斜線
				case 5
					oCell.CharStrikeout = com.sun.star.awt.FontStrikeout.X				' ×線
			end select
		next i
	msgbox "Success"
End Sub

CCFe-)[Calc]各種取消し線(2)


Sub CalcUnoFont()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByName("sheet1")
  		oCell = oSheet.getCellRangeByName("A1")
		oCell.String = "OSSでいこう"
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			' A1 Cellへ移動
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A1"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			' Strikeout
			oProp(0).Name = "Strikeout.Kind"
			oProp(0).Value = com.sun.star.awt.FontStrikeout.DOUBLE
		oDispatcher.executeDispatch(oFrame, ".uno:Strikeout", "", 0, oProp())
		msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
'
'[ Note ]
' com.sun.star.awt.FontStrikeout.SINGLE		: 1
' com.sun.star.awt.FontStrikeout.DOUBLE		: 2
' com.sun.star.awt.FontStrikeout.DONTKNOW	: 3	← NONEと同じ
' com.sun.star.awt.FontStrikeout.BOLD		: 4
' com.sun.star.awt.FontStrikeout.SLASH		: 5
' com.sun.star.awt.FontStrikeout.X			: 6

CCFe-)[Calc]各種OverLine(1)


Sub CalcUnoFont()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oTextCursor as Object
	Dim oText as String
		'
		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByName("sheet1")
  		for i = 0 to 4
  			oCell = oSheet.getCellByPosition( 0, i )
  			oText = "LibreOffficeです"
			oCell.String = oText
			'
			oTextCursor = oCell.createTextCursor()
			With oTextCursor
				.gotoStart( False )
				.goRight(Len(oText) , True )
				.setPropertyValue("CharEmphasis", i )
				.gotoEnd( False )
			End With
  		next i
    	msgbox "Success"
End Sub
'
' [ Note ]
' Overlineは、WriterとCalcでは異なる。
' Calc : Type ⇒ 0 ～4, Color : NG
' Writer : Type ⇒ 0 ～18, Color : OK

CCFe-)[Calc]各種OverLine(2)


Sub CalcUnoFont()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oText as String
		'
		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByName("sheet1")
  		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  		for i = 0 to 4
  			oCell = oSheet.getCellByPosition( 0, i )
  			oText = "LO and AOOです"
			oCell.String = oText
			' Overline
			oProp(0).Name = "Overline.LineStyle"
			oProp(0).Value = i
			' oProp(1).Name = "Overline.HasColor"		' Calcでは、Over lineの色は付かない
			' oProp(1).Value = true
			' oProp(2).Name = "Overline.Color"
			' oProp(2).Value = &HFF0000	
			oDispatcher.executeDispatch(oFrame, ".uno:Overline", "", 0, oProp())
  		next i
    	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
'
' [ Note ]
' LibreOffice 4.2から強調文字と上線が区別されたので、上記Codeでは i = 1 で上線が入るだけ

CCFe-)[Calc]浮き出し/浮き彫り文字(1)


Sub FontEffect()
	Dim oDoc as Object, oSheet as Object, oCell  as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Font Effect
		for i = 0 to 2
			oCell = oSheet.getCellByPosition( 0, i )
			oText = "LibreOffficeです"
			oCell.String = oText
			with oCell
				.CharHeight  = 20
				.CharHeightAsian = 20	
			end with	
			' 浮き出し/浮き彫り
			oTextCursor = oCell.createTextCursor()
			With oTextCursor
				.gotoStart( False )
				.goRight(Len(oText) , True )
				.setPropertyValue("CharRelief", i )
				.gotoEnd( False )
			End With
		next i
	msgbox "Success"
End Sub

CCFe-)[Calc]浮き出し/浮き彫り文字(2)


Sub CalcUnoFont()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByName("sheet1")
  		for i = 0 to 2
  			oCell = oSheet.getCellByPosition(0, i)
			oCell.String = "LO4.2.2です"
  		next i
  		'
  		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  		' A2 Cellへ移動
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A2"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		' 浮き出し
			oProp(0).Name = "CharacterRelief"
			oProp(0).Value = 1
		oDispatcher.executeDispatch(oFrame, ".uno:CharacterRelief", "", 0, oProp())
		' A3 Cellへ移動
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A3"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		 ' 浮き彫り
		 	oProp(0).Name = "CharacterRelief"
			oProp(0).Value = 2
		oDispatcher.executeDispatch(oFrame, ".uno:CharacterRelief", "", 0, oProp())
		msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCFe-)[Calc]中抜き文字(1)


Sub FontEffect()
	Dim oDoc as Object, oSheet as Object, oCell  as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Font Effect
		oCell = oSheet.getCellByPosition( 0, 0 )
		oText = "LibreOffficeです"
		oCell.String = oText
		with oCell
			.CharHeight  = 20
			.CharHeightAsian = 20
			.CharContoured = True
		end with	
		msgbox "Success"
End Sub

CCFe-)[Calc]中抜き文字(2)


Sub CalcUnoFont()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByName("sheet1")
  		oCell = oSheet.getCellByPosition(0, 0)
		oCell.String = "LO4.2.2です"
  		'
  		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  		' A1 Cellへ移動
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A1"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		' 中抜き
			oProp(0).Name = "OutlineFont"
			oProp(0).Value = true
		oDispatcher.executeDispatch(oFrame, ".uno:OutlineFont", "", 0, oProp())
		msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCFe-)[Calc]


{{ Position / Size }}

CCP-)[Calc]Cell内の位置設定(1)


Sub CellPropertiesSrv()
	Dim oDoc as Object, oSheet as Object
	Dim oCell(3) as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
	for i = 0 to 3
		oCell(i) = oSheet.getCellByPosition(0,i)
		oCell(i).Value = i*10
	next i 
		oCell(0).VertJustify = com.sun.star.table.CellVertJustify.STANDARD
		oCell(1).VertJustify = com.sun.star.table.CellVertJustify.TOP
		oCell(2).VertJustify = com.sun.star.table.CellVertJustify.CENTER
		oCell(3).VertJustify = com.sun.star.table.CellVertJustify.BOTTOM
	msgbox("Success")
End Sub

CCP-)[Calc]Cell内の位置設定(2)


Sub CellPropertiesSrv()
	Dim oDoc as Object, oSheet as Object
	Dim oCell(5) as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
	for i = 0 to 5
		oCell(i) = oSheet.getCellByPosition(0,i)
		oCell(i).Value = i*10
	next i 
		oCell(0).HoriJustify = com.sun.star.table.CellHoriJustify.STANDARD
		oCell(1).HoriJustify = com.sun.star.table.CellHoriJustify.LEFT
		oCell(2).HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
		oCell(3).HoriJustify = com.sun.star.table.CellHoriJustify.RIGHT
		oCell(4).HoriJustify = com.sun.star.table.CellHoriJustify.BLOCK
		oCell(5).HoriJustify = com.sun.star.table.CellHoriJustify.REPEAT
	msgbox("Success")
End Sub

CCP-)[Calc]Cell内の位置設定(3)


Sub CellPropertiesSrv()
	Dim oDoc as Object, oSheet as Object
	Dim oCell(8) as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 8
			oCell(i) = oSheet.getCellByPosition(0,i)
			oCell(i).Value = i*10
			if i = 4 then
				oCell(i).String = CStr(oCell(i).Value) & "Test"
			end if
		next i 
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A1"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			oProp(0).Name = "HorizontalJustification"
			oProp(0).Value = com.sun.star.table.CellHoriJustify.STANDARD
		oDispatcher.executeDispatch(oFrame, ".uno:HorizontalJustification", "", 0, oProp())
			'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A2"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			oProp(0).Name = "HorizontalJustification"
			oProp(0).Value = com.sun.star.table.CellHoriJustify.LEFT
		oDispatcher.executeDispatch(oFrame, ".uno:HorizontalJustification", "", 0, oProp())
			'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A3"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			oProp(0).Name = "HorizontalJustification"
			oProp(0).Value = com.sun.star.table.CellHoriJustify.CENTER
		oDispatcher.executeDispatch(oFrame, ".uno:HorizontalJustification", "", 0, oProp())
			'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A4"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			oProp(0).Name = "HorizontalJustification"
			oProp(0).Value = com.sun.star.table.CellHoriJustify.RIGHT
		oDispatcher.executeDispatch(oFrame, ".uno:HorizontalJustification", "", 0, oProp())
			'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A5"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			oProp(0).Name = "HorizontalJustification"
			oProp(0).Value = com.sun.star.table.CellHoriJustify.BLOCK
		oDispatcher.executeDispatch(oFrame, ".uno:HorizontalJustification", "", 0, oProp())
			'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A6"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			oProp(0).Name = "HorizontalJustification"
			oProp(0).Value = com.sun.star.table.CellHoriJustify.REPEAT
		oDispatcher.executeDispatch(oFrame, ".uno:HorizontalJustification", "", 0, oProp())
			'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A7"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			oProp(0).Name = "VerticalJustification"
			oProp(0).Value = com.sun.star.table.CellVertJustify.TOP
		oDispatcher.executeDispatch(oFrame, ".uno:VerticalJustification", "", 0, oProp())
			'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A8"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			oProp(0).Name = "VerticalJustification"
			oProp(0).Value = com.sun.star.table.CellVertJustify.CENTER	
		oDispatcher.executeDispatch(oFrame, ".uno:VerticalJustification", "", 0, oProp())
			'
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A9"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			oProp(0).Name = "VerticalJustification"
			oProp(0).Value = com.sun.star.table.CellVertJustify.BOTTOM
		oDispatcher.executeDispatch(oFrame, ".uno:VerticalJustification", "", 0, oProp())
		'
		msgbox("Success")
End Sub

CCP-)[Calc]Cell内の位置設定(4)


Sub UnoHideVisible()
   Dim oDoc as Object, oSheet as Object
	Dim oCell(8) as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 6
			oCell(i) = oSheet.getCellByPosition(0,i)
			select case i
				case 0
					oCell(i).String = "水平 / 両端揃え"
				case 1
					oCell(i).String = "水平 / 左揃え"
				case 2
					oCell(i).String = "水平 / 右揃え"
				case 3
					oCell(i).String = "水平 / 中央揃え"
				case 4
					oCell(i).String = "垂直 / 上揃え"
				case 5
					oCell(i).String = "垂直 / 中央揃え"
				case 6
					oCell(i).String = "垂直 / 下揃え"
			end select
		next i 
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Position
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "A1"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame, ".uno:AlignBlock", "", 0, Array())
		oProp(0).Name = "ToPoint"
			oProp(0).Value = "A2"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame, ".uno:AlignLeft", "", 0, Array())
		oProp(0).Name = "ToPoint"
			oProp(0).Value = "A3"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame, ".uno:AlignRight", "", 0, Array())
		oProp(0).Name = "ToPoint"
			oProp(0).Value = "A4"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame, ".uno:AlignHorizontalcenter", "", 0, Array())
		oProp(0).Name = "ToPoint"
			oProp(0).Value = "A5"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame, ".uno:AlignTop", "", 0, Array())
		oProp(0).Name = "ToPoint"
			oProp(0).Value = "A6"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame, ".uno:AlignVCenter", "", 0, Array())
		oProp(0).Name = "ToPoint"
			oProp(0).Value = "A7"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame, ".uno:AlignBottom", "", 0, Array())
		msgbox "Success", 0, "Position"
End Sub

CCP-)[Calc]任意のCell位置までの左からの距離


Sub CellPropertiesSrv()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oCellName as String
	Dim oPos as Long
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		oCellName = "B3"
		oCell =oSheet.getCellRangeByName(oCellName)
		oPos = oCell.Position.X/100
		oDisp = oCellName & " Cellの左端位置 は" & Chr(10) & Chr$(9) & _
					oPos & "  [mm] from left" & Chr$(10) & Chr$(9) & " ( A列の幅とほぼ同じ )" 
	msgbox(oDisp,0,"Cell の位置")
End Sub

CCP-)[Calc]任意のCell位置までの上からの距離


Sub CellPropertiesSrv()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oCellName as String
	Dim oPos as Long
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		oCellName = "B3"
		oCell =oSheet.getCellRangeByName(oCellName)
		oPos = oCell.Position.Y/100
		oDisp = oCellName & " Cellの上端位置 は" & Chr(10) & Chr$(9) & _
					oPos & "  [mm] from top" & Chr$(10) & Chr$(9) & " ( 1行目 +　2行目高さとほぼ同じ )" 
	msgbox(oDisp,0,"Cell の位置")
End Sub

CCP-)[Calc]Cell Size取得


Sub CellSize()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oCellHg as Double, oCellWdh as Double
	Dim oDisp As String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		oCell = oSheet.getCellByposition(1,1)	' B2
		oCellWdh = oCell.Size.Width / 100
		oCellHgt = oCell.Size.Height / 100
		oDisp = "[ Cell Size( About ) ]" & Chr$(10) & oCell.AbsoluteName & Chr$(10) & " Width = " & _
					CStr(oCellWdh) & " mm" & Chr$(10) & " Height = " & CStr(oCellHgt) & " mm"
		msgbox(oDisp,0,"Cell Size")
End Sub

CCP-)[Calc]

{{ 罫線 }}

CCL-)[Calc]選択範囲に罫線を引く(1)


Sub CalcLine()
	Dim oDoc as Object, oSheet as Object, oRange as Object
	Dim aTableBorder as Object, aLine as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oRange = oSheet.getCellRangeByName("B2:E8")
		aTableBorder = CreateUnoStruct("com.sun.star.table.TableBorder")
		aLine = CreateUnoStruct("com.sun.star.table.BorderLine")
		'
		'ラインの内容
			aLine.OuterLineWidth = 100		' in 0.01mm
			aLine.InnerLineWidth = 50		' in 0.01mm
			aLine.LineDistance = 100		' in 0.01mm
			aLine.Color = RGB(255,0,0)
		'
		'表用罫線外枠のライン指定
			aTableBorder.TopLine = aLine
			aTableBorder.BottomLine = aLine
			aTableBorder.LeftLine = aLine
			aTableBorder.RightLine = aLine
		'表用罫線外枠のライン表示のオン
			aTableBorder.IsTopLineValid = True
			aTableBorder.IsBottomLineValid = True
			aTableBorder.IsLeftLineValid = True
			aTableBorder.IsRightLineValid = True
		'表用罫線内側のライン指定
			aTableBorder.HorizontalLine = aLine
			aTableBorder.VerticalLine = aLine
		'表用罫線内側のライン表示のオン 
			aTableBorder.IsHorizontalLineValid = true
			aTableBorder.IsVerticalLineValid = true
		'範囲に表用罫線設定反映   
			oRange.TableBorder = aTableBorder
			'
		msgbox "Success"
End Sub
'
' [ Note ]
' LibreOffice3.5系は本Codeにて描写できたが、LibreOffice4.1( Windows )では、Error無く実行するが描写はしない。
' LibreOffice4.2 API Documentには記述がある。LibreOffice / Apache OpenOffice

CCL-)[Calc]選択範囲に罫線を引く(2)


Sub CalcLine()
	Dim oDoc As Object
	Dim oCtrl as Object
	Dim oSelRange as Object, oCellRange as Object
	Dim oBorder1 as Object, oBorder2 as Object, oBorder3 as Object, oBorder4 as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oSelRange = oCtrl.getActiveSheet().getCellRangeByName( "B3:D5" ) 
		oCtrl.select( oSelRange )
		'
  		oCellRange = oDoc.CurrentSelection(0)
  		' Border1 Property
  		oBorder1 = CreateUnoStruct("com.sun.star.table.BorderLine2")
  		oBorder1.Color = RGB(255, 0, 0)
  		oBorder1.LineWidth = 30
  		oBorder1.LineStyle = 2  
  		' Border2 Property
  		oBorder2 = CreateUnoStruct("com.sun.star.table.BorderLine2")
  		oBorder2.Color = RGB(0, 0, 255)
  		oBorder2.LineWidth = 10
  		oBorder2.LineStyle = 9
  		' Border3 Property
  		oBorder3 = CreateUnoStruct("com.sun.star.table.BorderLine2")
  		oBorder3.Color = RGB(0, 255, 0)
  		oBorder3.LineWidth = 30
  		oBorder3.LineStyle = 14
  		' Border4 Property
  		oBorder4 = CreateUnoStruct("com.sun.star.table.BorderLine2")
  		oBorder4.Color = RGB(0, 255, 255)
  		oBorder4.LineWidth = 30
  		oBorder4.LineStyle = 10
  		' Set Border
  		oCellRange.BottomBorder = oBorder1
  		oCellRange.TopBorder = oBorder2
  		oCellRange.LeftBorder = oBorder3
  		oCellRange.RightBorder = oBorder4
  		'
  		oSelRange = oCtrl.getActiveSheet().getCellRangeByName( "A1" ) 
		oCtrl.select( oSelRange )
  	msgbox "Success"
End Sub
' [ Note ]
' Top/Bottom と Left / Rgightでは線の太さやStyleによる。太さがStyle同じ時は ?
' [ LibreOffice ]
' com.sun.star.table.BorderLine2 / com.sun.star.table.BorderLineStyle
' 上記がNetwork Errorの場合は com.sun.star.table.BorderLine2 / com.sun.star.table.BorderLineStyle

CCL-)[Calc]選択範囲に罫線を引く(3)


Sub CalcLine()
	Dim oDoc As Object
	Dim oCtrl as Object
	Dim oSelRange as Object, oCellRange as Object
	Dim oBorder1 as Object, oBorder2 as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oSelRange = oCtrl.getActiveSheet().getCellRangeByName( "B3:D5" ) 
		oCtrl.select( oSelRange )
		'
  		oCellRange = oDoc.CurrentSelection(0)
  		' Border1 Property
  		oBorder1 = oCellRange.LeftBorder		' oCellRange.BottomBorder / LeftBorder / RightBorder でも同じ
  		oBorder1.Color = RGB(255, 0, 0)
  		oBorder1.InnerLineWidth = 30
  		oBorder1.LineStyle = 1			' 0 : Line / 1 : Dot( 点線 ) / 2 : Dash( 破線 )  
  		' Border2 Property
  		oBorder2 = oCellRange.RightBorder
  		oBorder2.Color = RGB(0, 0, 255)
  		oBorder2.InnerLineWidth = 10
  		oBorder2.LineStyle = 2
  		' Set Border
  		oCellRange.BottomBorder = oBorder1
  		oCellRange.TopBorder = oBorder2
  		oCellRange.LeftBorder = oBorder1
  		oCellRange.RightBorder = oBorder2
  		'
  		oSelRange = oCtrl.getActiveSheet().getCellRangeByName( "A1" ) 
		oCtrl.select( oSelRange )
  	msgbox "Success"
End Sub
'
' [ Note ]
' com.sun.star.table.BorderLine2 とは .LineWidth と .InneLineWidth が異なり、使えるLineStyleも限定される模様。

CCL-)[Calc]外枠に罫線を引く


Sub UnoCalcLine()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oProp1(7) as new com.sun.star.beans.PropertyValue
	Dim oWidthPt1 as Integer, oWidthPt2 as Integer, oWidthPt3 as Integer
	Dim oColor1 as Long, oColor2 as Long, oColor3 as Long 
		'
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "B3:C5"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
		oWidthPt1 = 150		' ← 幅値の設定は？
		oWidthPt2 =  80
		oWidthPt3 = 10
		oColor1 = CLng("&HFF0000")			' Red
		oColor2 = CLng("&H00FF00")			' Green
		oColor3 = CLng("&H0000FF")			' Blue
		'
		' 選択範囲の左に線を引く
		oProp1(0).Name = "BorderOuter.LeftBorder"
		oProp1(0).Value = Array(oColor1, 0, oWidthPt1, 0)						
		oProp1(1).Name = "BorderOuter.LeftDistance"
		oProp1(1).Value = 10
		' 選択範囲の右に線を引く
		oProp1(2).Name = "BorderOuter.RightBorder"
		oProp1(2).Value = Array(oColor2, 0, oWidthPt2, 0)						
		oProp1(3).Name = "BorderOuter.RightDistance"
		oProp1(3).Value = 0
		' 選択範囲の上に線を引く
		oProp1(4).Name = "BorderOuter.TopBorder"
		oProp1(4).Value = Array(oColor3, 0, oWidthPt3, 0)						
		oProp1(5).Name = "BorderOuter.TopDistance"
		oProp1(5).Value = 0
		' 選択範囲の下には線を引かない
		Rem oProp1(6).Name = "BorderOuter.RightBorder"
		Rem oProp1(6).Value = Array(0, 0, oWidthPt, 0)						
		Rem oProp1(7).Name = "BorderOuter.RightDistance"
		Rem oProp1(7).Value = 0
		oDispatcher.executeDispatch(oFrame, ".uno:BorderOuter", "", 0, oProp1())
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A1"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		msgbox "Success"
End Sub
'
' [ Note ]
' Apache OpenOffice / :: com :: sun :: star :: table :: / Struct BorderLine
' Array(Color, InnerLineWidth, OuterLineWidth, LineDistance)
' BorderOuterでは、InnerLineWidth / LineDistanceの設定は不可?

CCL-)[Calc]Cellに影を付ける(1)


Sub UnoCalcLine()
	Dim oDoc As Object, oSheet As Object, oCell as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oProp1(3) as new com.sun.star.beans.PropertyValue
		'
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "B3:C5"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
		oProp1(0).Name = "BorderShadow.Location"
		oProp1(0).Value = com.sun.star.table.ShadowLocation.BOTTOM_LEFT
		oProp1(1).Name = "BorderShadow.Width"
		oProp1(1).Value = 200			' Cellの端からの間隔 : unit 1/100 mm
		oProp1(2).Name = "BorderShadow.IsTransparent"
		oProp1(2).Value = false
		oProp1(3).Name = "BorderShadow.Color"
		oProp1(3).Value = RGB( 0, 255, 0 )
		oDispatcher.executeDispatch(oFrame, ".uno:BorderShadow", "", 0, oProp1())
		'
		msgbox "Success"
End Sub
'
' [ Note ]
' enum com.sun.star.table.ShadowLocation
' LibreOffice / Apache openOffice

CCL-)[Calc]Cellに影を付ける(2)


Sub CellShadow()
	Dim oDoc as Object, oSheet as Object, oCell As Object
	Dim oShadow As New com.sun.star.table.ShadowFormat
		oDoc = ThisComponent
		oSheet = oDoc.getSheets.getByIndex(0)
  		oCell = oSheet.getCellRangeByName( "B2:C4" )
  		' CellのBackColor
  		' oCell.CellBackColor = RGB( 255, 128, 128 )
  		'
  		oShadow.Color = RGB( 0, 0, 255 )  	' Shadow color
  		oShadow.Location = com.sun.star.table.ShadowLocation.TOP_RIGHT
  		oShadow.IsTransparent = False
  		oShadow.ShadowWidth = 250  	' 1/100 mm
  		oCell.ShadowFormat = oShadow
  		'
  		msgbox "Success"
End Sub
'
' [ Note ]
' com.sun.star.table.ShadowFormat
' LibreOffice / Apache OpenOffice

CCL-)[Calc]









{{ Protection }}

CCPct-)[Calc]保護する＆ 数式を表示しない(1)


Sub CellProtect()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oProp2(1) as  new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A1"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
		' 直接設定した書式の解除
		oDispatcher.executeDispatch(oFrame, ".uno:ResetAttributes", "", 0, Array())
		' Cellの保護Tab/保護する
		oProp2(0).Name = "Protection.Locked"	
		oProp2(0).Value = false							' true : Check ON / false : Check Off
		' 数式を表示しない
		oProp2(1).Name = "Protection.FormulasHidden"
		oProp2(1).Value = true
		oDispatcher.executeDispatch(oFrame, ".uno:Protection", "", 0, oProp2())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCPct-)[Calc]保護する＆ 数式を表示しない(2)


Sub CellProtect()
	Dim oDoc as Object, oSheet as Object, oRange as Object
	Dim oUnoCellPrct as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		oRange = oSheet.getCellRangeByName("A1:C3")
		'
		' Defalt setting for protection of cell
		oRange.setPropertyToDefault("CellProtection")
		'
		oUnoCellPrct = createUnoStruct("com.sun.star.util.CellProtection")
		With oUnoCellPrct
   			.IsFormulaHidden = true
   			.IsLocked = true
		End With
		oRange.setPropertyValue( "CellProtection", oUnoCellPrct )
		msgbox "Success"
End Sub

CCPct-)[Calc]すべて表示しない(1)


Sub CellProtect()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oProp2(0) as  new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A1"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		' 直接設定した書式の解除
		oDispatcher.executeDispatch(oFrame, ".uno:ResetAttributes", "", 0, Array())
		' すべて表示しない
		oProp2(0).Name = "Protection.Hidden"
		oProp2(0).Value = true							' true : Check ON / false : Check Off
		oDispatcher.executeDispatch(oFrame, ".uno:Protection", "", 0, oProp2())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCPct-)[Calc]すべて表示しない(2)

Sub CellProtect()
	Dim oDoc as Object, oSheet as Object, oRange as Object
	Dim oUnoCellPrct as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		oRange = oSheet.getCellRangeByName("A1:C3")
		'
		' Defalt setting for protection of cell
		oRange.setPropertyToDefault("CellProtection")
		'
		oUnoCellPrct = createUnoStruct("com.sun.star.util.CellProtection")
		With oUnoCellPrct
   			.IsHidden = true
		End With
		oRange.setPropertyValue( "CellProtection", oUnoCellPrct )
		msgbox "Success"
End Sub

CCPct-)[Calc]印刷しない(1)


Sub CellProtect()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
	Dim oProp2(0) as  new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A1"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		' 直接設定した書式の解除
		oDispatcher.executeDispatch(oFrame, ".uno:ResetAttributes", "", 0, Array())
		' 印刷しない
		oProp2(0).Name = "Protection.HiddenInPrintout"		
		oProp2(0).Value = true
		oDispatcher.executeDispatch(oFrame, ".uno:Protection", "", 0, oProp2())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCPct-)[Calc]印刷しない(2)

Sub CellProtect()
	Dim oDoc as Object, oSheet as Object, oRange as Object
	Dim oUnoCellPrct as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		oRange = oSheet.getCellRangeByName("A1:C3")
		'
		' Defalt setting for protection of cell
		oRange.setPropertyToDefault("CellProtection")
		'
		oUnoCellPrct = createUnoStruct("com.sun.star.util.CellProtection")
		With oUnoCellPrct
   			.IsPrintHidden = true
		End With
		oRange.setPropertyValue( "CellProtection", oUnoCellPrct )
		msgbox "Success"
End Sub

CCPct-)[Calc]Cellの保護をDefaultに設定

Sub CellProtect()
	Dim oDoc as Object, oSheet as Object, oRange as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		oRange = oSheet.getCellRangeByName("A1")
		' 
		oRange.setPropertyToDefault("CellProtection")
		msgbox "Success"
End Sub








{{ Color }}

CCCo-)[Calc]文字Color


Sub CalcCharColor()
	Dim oDoc as Object, oSheet as Object
	Dim oCell(1) as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		for i = 0 to 1
			oCell(i) = oSheet.getCellByPosition(0,i)
			select case i
				case 0
					with oCell(i)
						.String = "LibreOffice"
						.charColor = RGB(0,0,255)
						.IsTextWrapped = false
					end with
				case 1
					with oCell(i)
						.String = "Apache OpenOffice"
						.charColor = RGB(0,255,0)
						.IsTextWrapped = true
					end with
			end select
		next i
		msgbox "Success",0,"CharColor"    
End Sub

CCCo-)[Calc]文字列の金額部分（右部分)のみを赤色にする


Sub CalcCharColor()
	Dim oDoc as Object, oSheet as Object
	Dim oCell as Object
	Dim oTextCursor as Object
		oDoc=ThisComponent
		oSheet=oDoc.getSheets().getByName("sheet1")
		oCell=oSheet.getCellByPosition(0,0)
		oCell.String="1,000円（2009/8/16)"
		oTextCursor = oCell.createTextCursor()
		oCNum= InStr(1,oCell.String,"円")		'「円」までの文字数を調べる。
		With oTextCursor
			.gotoStart( False )
			.goRight( oCNum, True )
			.setPropertyValue( "CharColor", RGB(255,0,0) )
			.gotoEnd( False )
		End With
		msgbox "Success"    
End Sub

{{ autoFormat }}

CCAF-)[Calc]autoFormat


Sub oCalcAutoFormat
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCellrange as Object
	Dim oAutoFormat as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCellRange = oSheet.getCellRangeByPosition(0, 0, 5, 5)
		oCellRange.autoFormat("3D")
		'
		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

CCAF-)[Calc]









{{ Annotation( Comment ) }}

CCCmt-)[Calc]CellのComment取得


Sub CalcAnnotation()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCell as Object
	Dim oCmt as Object
	Dim oCmtStr as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,0)
		oCmt = oCell.getAnnotation()
		oCmtStr = oCmt.getString
		msgbox(oCmtStr, 0, "CellのComment取得")
End Sub

CCCmt-)[Calc]CellへのComment挿入


Sub CalcAnnotation()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCell as Object
	Dim oCmt as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,0)
		' Annotation Object 作成
		oCmt = oCell.getAnnotation()
		' 新規Commentの挿入
		oSheet.getAnnotations().insertNew(oCell.getCellAddress(), "Commentの挿入")
		' Commentの表示
		oCmt.setIsVisible( True )
		'
		msgbox "Success"
End Sub

CCCmt-)[Calc]CellのCommentを削除(1)

Sub CalcAnnotation()
	Dim oDoc as Object
	Dim document   as object
	Dim dispatcher as object
	Dim oArg(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		document   = oDoc.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' B2 Cell へ移動
		oArg(0).Name = "ToPoint"
		oArg(0).Value = "$B$2"
		dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, oArg())
		'
		' Comment 削除
		dispatcher.executeDispatch(document, ".uno:DeleteNote", "", 0, Array())
		msgbox "Success"
End Sub

CCCmt-)[Calc]CellのCommentを削除(2)

Sub CalcAnnotation()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCell as Object, oCellRange as Object
	Dim oCmt as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,0)
		' Annotation Object 作成
		oCmt = oCell.getAnnotation()
		' 新規Commentの挿入
		oSheet.getAnnotations().insertNew(oCell.getCellAddress(), "Commentの挿入")
		' Commentの表示
		oCmt.setIsVisible( true )
		msgbox "Comment表示", 0, "Comment"
		'
		' Commentを非表示にしないと表示が消えない
		oCmt.setIsVisible( false )
		oCellRange = oSheet.getCellRangeByName("A1")
		oCellRange.clearContents(com.sun.star.sheet.CellFlags.ANNOTATION)
		msgbox "Commentの削除", 0, "Comment"
End Sub

CCCmt-)[Calc]Comment設定数取得


Sub CalcAnnotation()
	Dim oDoc as Object, oSheet as Object
	Dim oCell(2) as Object
	Dim oShtName as String
	Dim oBfrCnt as Long, oAftCnt as Long
	Dim oCmtStr as String
	Dim oCmt as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oShtName = "sheet1"
		oSheet = oDoc.getSheets().getByName(oShtName)
		' Before
		oBfrCnt = oSheet.annotations.count
		oDisp = oShtName & "における" & Chr$(10) & _
					"Annotation数 = " & oBfrCnt & "( Before )"
		'
		for i = 0 to 2
			oCell(i) = oSheet.getCellByPosition(0, 3 + 3*i )
			oCmtStr = "Commnet" & i
			oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
			oCmt = oCell(i).getAnnotation()
			oCmt.setIsVisible( True )
		next i
		' After
		oAftCnt = oSheet.annotations.count
		oDisp = oDisp & Chr$(10) & "Annotation数 = " & oAftCnt & "( After )"
		msgbox oDisp,0,"Annotation"
End Sub

CCCmt-)[Calc]Fill Collor設定


Sub CalcAnnotation()
	Dim oDoc as Object, oSheet as Object
	Dim oCell(2) as Object
	Dim oShtName as String
	Dim oCmtStr as String
	Dim oCmt as Object
	Dim oAntShape as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oShtName = "sheet1"
		oSheet = oDoc.getSheets().getByName(oShtName)
		'
		for i = 0 to 2
			oCell(i) = oSheet.getCellByPosition(0, 3 + 3*i )
			oCmtStr = "Commnet" & i
			oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
			oCmt = oCell(i).getAnnotation()
			oCmt.setIsVisible( True )
			' Properties
			oAntShape = oCmt.annotationShape
			select case i
				case 0
					oAntShape.fillColor = RGB(255,255,0)
				case 1
					oAntShape.fillColor = RGB(0,255,255)
				case 2
					oAntShape.fillColor = RGB(255,0,255)
			end select
		next i
		'
		oDisp = "Success"
		msgbox oDisp,0,"Annotation"
End Sub

CCCmt-)[Calc]文字Color設定


Sub CalcAnnotation()
	Dim oDoc as Object, oSheet as Object
	Dim oCell(2) as Object
	Dim oShtName as String
	Dim oCmtStr as String
	Dim oCmt as Object
	Dim oAntShape as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oShtName = "sheet1"
		oSheet = oDoc.getSheets().getByName(oShtName)
		'
		for i = 0 to 2
			oCell(i) = oSheet.getCellByPosition(0, 3 + 3*i )
			oCmtStr = "Commnet" & i
			oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
			oCmt = oCell(i).getAnnotation()
			oCmt.setIsVisible( True )
			' Properties
			oAntShape = oCmt.annotationShape
			select case i
				case 0
					oAntShape.CharColor = RGB(255,123,0)
				case 1
					oAntShape.CharColor = RGB(0,255,123)
				case 2
					oAntShape.CharColor = RGB(123,0,255)
			end select
		next i
		'
		oDisp = "Success"
		msgbox oDisp,0,"Annotation"
End Sub

CCCmt-)[Calc]文字Font( FontName / Posture / Hieght )設定


Sub CalcAnnotation()
	Dim oDoc as Object, oSheet as Object
	Dim oCell(2) as Object
	Dim oShtName as String
	Dim oCmtStr as String
	Dim oCmt as Object
	Dim oAntShape as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oShtName = "sheet1"
		oSheet = oDoc.getSheets().getByName(oShtName)
		'
		for i = 0 to 2
			oCell(i) = oSheet.getCellByPosition(0, 3 + 4*i )
			oCmtStr = "Commentの設定" & i
			oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
			oCmt = oCell(i).getAnnotation()
			oCmt.setIsVisible( True )
			' Properties
			oAntShape = oCmt.annotationShape
			select case i
				case 0
					with oAntShape
						.CharFontName = "Arial"
						.CharFontNameAsian = "Arial"
						.CharPosture = com.sun.star.awt.FontSlant.ITALIC
						.CharPostureAsian = com.sun.star.awt.FontSlant.OBLIQUE
						.CharHeight=12
						.CharHeightAsian=16
					end with
				case 1
					with oAntShape
						.CharFontName = "MS Gothic"
						.CharFontNameAsian = "MS UI Gothic"
						.CharPosture = com.sun.star.awt.FontSlant.REVERSE_OBLIQUE
						.CharPostureAsian = com.sun.star.awt.FontSlant.REVERSE_ITALIC
						.CharHeight=16
						.CharHeightAsian=10
					end with
				case 2
					with oAntShape
						.CharFontName = "Century"
						.CharFontNameAsian = "MS Gothic"
						.CharPosture = com.sun.star.awt.FontSlant.NONE
						.CharPostureAsian = com.sun.star.awt.FontSlant.ITALIC
						.CharHeight=14
						.CharHeightAsian=14
					end with
			end select
		next i
		'
		oDisp = "Success"
		msgbox oDisp,0,"Annotation"
End Sub

CCCmt-)[Calc]線のProperties変更

Sub CalcAnnotation()
	Dim oDoc as Object, oSheet as Object
	Dim oCell(14) as Object
	Dim oShtName as String
	Dim oCmtStr as String
	Dim oCmt as Object
	Dim oAntShape as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oShtName = "sheet1"
		oSheet = oDoc.getSheets().getByName(oShtName)
		'
		for i = 0 to 13
			if i < 7 then
				oCell(i) = oSheet.getCellByPosition(0, 3 + 3*i )
			else
				oCell(i) = oSheet.getCellByPosition(3, 3 + 3*(i-7))
			end if
			oCmt = oCell(i).getAnnotation()
			' Properties of Line	
			select case i
				case 0
					oCmtStr = "破線(No LineDashName)"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)		'　LineのＰｒｏｐｅｒｔｉｅｓ変更前にCommentを設定する必要がある。
					oCmt.setIsVisible( True )	
					oAntShape = oCmt.annotationShape		' Comment設定後に取得する必要がある。		
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(255,0,0)
				case 1
					oCmtStr = "極細の破線"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)	
					oCmt.setIsVisible( True )	
					oAntShape = oCmt.annotationShape
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oAntShape.LineDashName = "Ultrafine Dashed"
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(200,50,0)
				case 2
					oCmtStr = "細かい破線"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)	
					oCmt.setIsVisible( True )	
					oAntShape = oCmt.annotationShape
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oAntShape.LineDashName = "Fine Dashed"
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(150,100,0)
				case 3
					oCmtStr = "二点三破線"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)	
					oCmt.setIsVisible( True )
					oAntShape = oCmt.annotationShape
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oAntShape.LineDashName = "Ultrafine 2 Dots 3 Dashes"		' ←　いつからか追加されている
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(100,150,0)
				case 4
					oCmtStr = "細かい点線"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)	
					oCmt.setIsVisible( True )
					oAntShape = oCmt.annotationShape
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oAntShape.LineDashName = "Fine Dotted"
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(50,200,0)
				case 5
					oCmtStr = "細かい点線が集まった線"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)	
					oCmt.setIsVisible( True )
					oAntShape = oCmt.annotationShape
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oAntShape.LineDashName = "Line with Fine Dots"
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(0,255,0)
				case 6
					oCmtStr = "細かい破線(可変)"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)	
					oCmt.setIsVisible( True )
					oAntShape = oCmt.annotationShape
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oAntShape.LineDashName = "Fine Dashed (var)"	' LO5.0.2では線のスタイルに項目が無い(細かい破線と同じ) / AOO4.0.2では線種がある
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(0,200,50)
				case 7
					oCmtStr = "三破線三点鎖線"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)	
					oCmt.setIsVisible( True )
					oAntShape = oCmt.annotationShape
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oAntShape.LineDashName = "3 Dashes 3 Dots (var)"
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(0,150,100)
				case 8
					oCmtStr = "極細の点線(可変)"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)	
					oCmt.setIsVisible( True )
					oAntShape = oCmt.annotationShape
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oAntShape.LineDashName = "Ultrafine Dotted (var)"	' LO5.0.2では線のスタイルに項目が無い(極細の破線と同じ) / AOO4.0.2では線種がある
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(0,100,150)
				case 9
					oCmtStr = "線スタイル9"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)	
					oCmt.setIsVisible( True )
					oAntShape = oCmt.annotationShape
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oAntShape.LineDashName = "Line Style 9"
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(0,50,200)
				case 10
					oCmtStr = "二点鎖線"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)	
					oCmt.setIsVisible( True )
					oAntShape = oCmt.annotationShape
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oAntShape.LineDashName = "2 Dots 1 Dash"
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(0,0,255)
				case 11
					oCmtStr = "破線(可変)"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)	
					oCmt.setIsVisible( True )
					oAntShape = oCmt.annotationShape
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
					oAntShape.LineDashName = "Dashed (var)"
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(200,200,200)
				case 12
					oCmtStr = "実線"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
					oCmt.setIsVisible( True )	
					oAntShape = oCmt.annotationShape		
					oAntShape.LineStyle = com.sun.star.drawing.LineStyle.SOLID
					oAntShape.LineWidth = 100
					oAntShape.LineColor = RGB(100,100,100)
				case 13
					oCmtStr = "設定なし"
					oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
					oCmt.setIsVisible( True )	
			'		oAntShape = oCmt.annotationShape	
			'		oAntShape.LineStyle = com.sun.star.drawing.LineStyle.ＮＯＮＥ		' Errorになる
			end select
		next i
		'
		oDisp = "Success( LO5.0.2 )"
		msgbox oDisp,0,"Annotation"
End Sub
'
' [ Note ]
' Reference Site : Basic OpenOffice( Apache OpenOffice Basic en espanol )

CCCmt-)[Calc]Comment ObjectからCell Object取得


Sub CalcAnnotation()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oCmt as Object, oPntCmt as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,0)
		oCell.String = "A1 Cellの値"
		oCmt = oCell.getAnnotation()
		oPntCmt = oCmt.getParent()
		msgbox(oPntCmt.String, 0, "Comment　Cellの文字")
End Sub

CCCmt-)[Calc]Commnetの最終更新者と更新日取得


Sub CalcAnnotation()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oCmt as Object
	Dim oDate as String, oAuth as String
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,0)
		' Annotation Object 作成
		oCmt = oCell.getAnnotation()
		' 新規Commentの挿入
		oSheet.getAnnotations().insertNew(oCell.getCellAddress(), "Commentの更新")
		' Commnet最終更新者と日付取得
		oAuth = oCmt.getAuthor()
		oDate = oCmt.getDate()
		oDisp = "Commnet更新者 ⇒ " & oAuth & Chr$(10) & "Commnet更新日 ⇒ " & oDate
		msgbox oDisp, 0, "Commnet"
End Sub

CCCmt-)[Calc]Commnet ObjectのAddress取得


Sub CalcAnnotation()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oCmt as Object, oCmtAddr as Object
	Dim oCol as Long, oRow as Long 
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(2,5)
		' Annotation Object 作成
		oCmt = oCell.getAnnotation()
		' com:.sun.star.table.CellAddress
		CmtAddr = oCmt.getPosition()
		oCol = CmtAddr.Column
		oRow = CmtAddr.Row
		'
		oDisp = "Address of Commnet Object" & Chr$(10) & " ⇒ (" & oCol & ", " & oRow & ")"
		msgbox oDisp, 0, "Commnet"
End Sub

CCCmt-)[Calc]


[ 内容の削除 ]

CCC-)[Calc]Claer Contents(1)

Sub CalcContentsClear()
	Dim Flags as Long
	Dim oDoc as Object
	Dim oSheet as Object
		oDoc=ThisComponent
		oSheet=oDoc.sheets(0)
		oCellRange=oSheet.getCellRangeByPosition(0,0,3,3) '←A1～D4の範囲
		Flags=com.sun.star.sheet.CellFlags.STRING +　com.sun.star.sheet.CellFlags.VALUE　+ com.sun.star.sheet.CellFlags.FORMULA
		oCellRange.clearContents(Flags)
End Sub
'
' [ Note ]
' VALUE			: selects constant numeric values that are not formatted as dates or times.  
' DATETIME		: selects constant numeric values that have a date or time number format.  
' STRING		: selects constant strings.  
' ANNOTATION	: selects cell annotations.  
' FORMULA		: selects formulas.  
' HARDATTR		: selects all explicit formatting, but not the formatting which is applied implicitly through style sheets.  
' STYLES		: selects cell styles.  
' OBJECTS		: selects drawing objects.  
' EDITATTR		: selects formatting within parts of the cell contents.  
' FORMATTED		: selects cells with formatting within the cells or cells with more than one paragraph within the cells.

CCC-)[Calc]Claer Contents(2)

Sub CalcContentsClear()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp1(0) as new com.sun.star.beans.PropertyValue
	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")
			oProp1(0).Name = "ToPoint"
			oProp1(0).Value = "A1:B6"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
			oProp(0).Name = "Flags"
			oProp(0).Value = "SNDFT"
		oDispatcher.executeDispatch(oFrame, ".uno:Delete", "", 0, oProp())
		msgbox "Success"
End Sub
'
' [ Flag Value ]
' S    : String ( テキスト ) 
' V    : Value ( 値 )
' D    : Date ( 日付 )
' F    : Formula ( 式 )
' N    : Note ( コメント )		' ← Comentを表示のままでは、表示が消えない( ver4.0.1.2 )
' T    : Format ( 書式 )
' 空白 : Object ( オブジェクト )
' A    : 全て

CCC-)[Calc]指定範囲の内容を全てClear

Sub subClearWrksheet(i as integer,sRange as string)
    Dim oRange as object
    	oRange = ThisComponent.getSheets().getByIndex(i).getCellRangeByName(sRange)
    	oRange.clearContents(511)
End Sub

CCC-)[Calc]Sheetの内容を全てClear ⇔ Clear in sheet

Sub subClearWrksheet()
    Dim oRange as object
    	'oRange = ThisComponent.getSheets().getByIndex(0).getCellRangeByName(sRange)
    	oRange = ThisComponent.getSheets().getByIndex(0)
    	oRange.clearContents(511)
    	msgbox "Success",0,"LO6.4.3.2(x64)"
End Sub
'
' clearContentsの値は以下。複数の場合は加算。clearContents() = clearContents(1+2+4+8+16+32+64+128+256)
' 1 : 数値をクリアする場合
' 2 : 日付や時刻をクリアする場合
' 4 : 文字列をクリアする場合
' 8 : セルのコメントをクリアする場合
' 16 : 関数 (数式) をクリアする場合
' 32 : セルに直接指定された書式をクリアする場合
' 64 : セルに間接的に指定された書式をクリアする場合
' 128 : セルに配置された描画オブジェクトをクリアする場合
' 256 : セル内の一部のテキストに対してのみ指定された書式をクリア








[ Selection ]

CCSel-)[Calc]CellのSelection(1)


Sub CellSelection()
	Dim oDoc as Object, oCtrl as Object
	Dim oSelRange as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oSelRange = oCtrl.getActiveSheet().getCellRangeByName( "A1" ) 
		oCtrl.select( oSelRange )
		'
	msgbox "Success"
End Sub
'
' [ Note ]
' .select後、Curosrを別Cellに移動させても、A1がselectされたままになるので、selectが不要になれば選択解除を行うこと。

CCSel-)[Calc]CellのSelection(2)


Sub CellSelection()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A1"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCSel-)[Calc]Current Cellを含むArea Blockを選択


Sub UnoSelection()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			oProp(0).Name = "ToPoint"
			oProp(0).Value = "B3"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame, ".uno:SelectData", "", 0, Array())
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCSel-)[Calc]ColumnのSelection(1)


Sub ColSelection()
	Dim oDoc as Object, oCtrl as Object
	Dim oSheet as Object
	Dim oSelRange as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oSheet = oDoc.getSheets().getByName("sheet1")
		oSelRange = oSheet.getColumns().getByIndex(1)		' B Column
		oCtrl.select( oSelRange )
		'
	msgbox "Success"
End Sub
'
' [ Note ]
' .select後、Curosrを別Cellに移動させても、B列がselectされたままになるので、selectが不要になれば選択解除を行うこと。

CCSel-)[Calc]ColumnのSelection(2)


Sub ColSelection()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "B:B"			' B Column
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCSel-)[Calc]ColumnのSelection(3)


Sub ColSelection()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "B2"			' B1 Cell
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame, ".uno:SelectColumn", "", 0, Array())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCSel-)[Calc]RowのSelection(1)


Sub RowSelection()
	Dim oDoc as Object, oCtrl as Object
	Dim oSheet as Object
	Dim oSelRange as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oSheet = oDoc.getSheets().getByName("sheet1")
		oSelRange = oSheet.getRows().getByIndex(1)		' No.2 Row
		oCtrl.select( oSelRange )
		'
	msgbox "Success"
End Sub
'
' [ Note ]
' .select後、Curosrを別Cellに移動させても、2行目がselectされたままになるので、selectが不要になれば選択解除を行うこと。

CCSel-)[Calc]RowのSelection(2)


Sub RowSelection()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "3:3"			' No.3 Row
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCSel-)[Calc]RowのSelection(3)


Sub RowSelection()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A1"			' A1 Cell
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame, ".uno:SelectRow", "", 0, Array())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCSel-)[Calc]Selection解除(1)


Sub DeSelection()
	Dim oDoc as Object, oCtrl as Object
	Dim oUtilUrl as Object
	Dim oUrlTrans as Object
	Dim oDeSel as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oUtilUrl = CreateUnoStruct("com.sun.star.util.URL")
  		oUtilUrl.Complete = ".uno:Deselect"
  		oUrlTrans = CreateUnoService("com.sun.star.util.URLTransformer")
    	oUrlTrans.parseStrict(oUtilUrl)
  		oDeSel = oCtrl.queryDispatch(oUtilUrl, "_self", 0)
  		oDeSel.dispatch(oUtilUrl, Array()
	msgbox "Success"
End Sub

CCSel-)[Calc]Selection解除(2)


Sub DeSelection()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oDispatcher.executeDispatch(oFrame, ".uno:Deselect", "", 0, oProp())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
'
' [ Note ]
' 本Codeを slot 値を用いて記すと Selection解除(1) になる

CCSel-)[Calc]選択Cellの選択状態を調べる


Sub oCalcIsAnythingSelected()
	Dim oDoc as Object
	Dim oSelection as object
	Dim oImpName as String, oString as String
	Dim oCount as Integer
	Dim oDisp as String
		oDoc = ThisComponent
		oSelection = oDoc.getCurrentSelection()
		'
		oDisp = "[ Current Select in Calc ]" & Chr$(10)
		If oSelection.supportsService("com.sun.star.sheet.SheetCell") then
			oImpName = oSelection.getImplementationName()
			oString = oSelection.getString()
			oDisp = oDisp & "One Cell Selected : " & oImpName & Chr$(10) & _
							"Strimg : " & oString & Chr$(10)
		Else
			If oSelection.supportsService("com.sun.star.sheet.SheetCellRange") then
				oImpName = oSelection.getImplementationName()
				oDisp = oDisp & "One Cell Range Selected : " & oImpName & Chr$(10)
			Else
				If oSelection.supportsService("com.sun.star.sheet.SheetCellRanges") then			' SheetCellRanges : 複数
					oImpName = oSelection.getImplementationName()
					oCount = oSelection.getCount()
					oDisp = oDisp & "Multiple Cell Range Selected : " & oImpName & Chr$(10) & _
								"Count : " & oCount & Chr$(10)
				Else
					oImpName = oSelection.getImplementationName()
					oDisp = oDisp & "Something else Selected : " & oImpName & Chr$(10)
				End If
			End If
		End If		
		msgbox(oDisp,0,"Is Calc anything select? ")
End Sub

CCSel-)[Calc]選択Cell全てに文字列を入力


Sub oSetSlectedCell()
	Dim oStr
	Dim oSelections
	DIm oCell
	Dim oRanges
		oStr = "Current Controll"
		oSelections = ThisComponent.getCurrentSelection()
		If IsNull(oSelections) Then Exit Sub
	'	
		If oSelections.supportsService( "com.sun.star.sheet.SheetCell") then
			oCell = oSelections
			oCell.setString(oStr)
		ElseIf oSelections.supportsService( "com.sun.star.sheet.SheetCellRange") then
			SetRangeText(oSelections, oStr)
		ElseIf oSelections.supportsService( "com.sun.star.sheet.SheetCellRanges") then
			oRanges = oSelections
			for i = 0 to oRange.getCount()-1
				setRangeText(oRanges.getByIndex(i), oStr)
			next i
		Else
			oImpName = oSelections.getImplementationName()
			print oImpName
		End If	
End Sub

'[ Function1 ]
Function setRangeText(oRange, s as String)
	Dim nCol as Long
	Dim nROw as Long
	Dim oCols
	Dim oRows
		oCols = oRange.Columns
		oRows = oRange.Rows
		for nCol = 0 to oCols.getCount()-1
			for nRow = 0 to oRows.getCount()-1
				oRange.getCellByPosition(nCol,nRow).setString(s)
			next nRow
		next nCol
End Function

CCSel-)[Calc]Ctrl + Shift + 矢印

Sub CalcSelection()
	Dim oDoc as Object, oSheet as Object, oCellA as Object, oCellB as Object, oCellC as Object, oCellD as Object, oCellE as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oDoc=ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 4
			oCellA = oSheet.getCellByPosition(0, i )
			oCellB = oSheet.getCellByPosition(1, i )
			oCellC = oSheet.getCellByPosition(2, i )
			oCellD = oSheet.getCellByPosition(3, i )
			oCellE = oSheet.getCellByPosition(4, i )
			oCellA.Value = i + 1
			oCellB.Formula = "=A" & (i + 1) & "*10"
			oCellC.Formula = "=A" & (i + 1) & "+ B" & (i + 1)
			oCellD.Formula = "=B" & (i + 1) & "^2"
			oCellE.Formula = "=C" & (i + 1) & "^2"
		next i
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	' C3 Cellへ移動
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "C3"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
	' Ctrl + Shift + ↑
		oDispatcher.executeDispatch(oFrame, ".uno:GoUpToStartOfDataSel", "", 0, Array())
		msgbox "Ctrl + Shift + 上矢印",0,"範囲選択"
	' Ctrl + Shift + ↓
		oDispatcher.executeDispatch(oFrame, ".uno:GoDownToEndOfDataSel", "", 0, Array())
		msgbox "Ctrl + Shift + 下矢印",0,"範囲選択"
	' Ctrl + Shift + ←
		oDispatcher.executeDispatch(oFrame, ".uno:GoLeftToStartOfDataSel", "", 0, Array())
		msgbox "Ctrl + Shift + 左矢印",0,"範囲選択"
	' Ctrl + Shift +  →
		oDispatcher.executeDispatch(oFrame, ".uno:GoRightToEndOfDataSel", "", 0, Array())
		msgbox "Ctrl + Shift + 右矢印",0,"範囲選択"
End Sub

CCSel-)[Calc]Page Down / Page Up / Page Left / Page Rightの選択

Sub CalcSelection()
	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")
	' S10 Cellへ移動
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "R10"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
	' Page Down 
		msgbox "R10 Cell !!",0,"表示画面Areaの選択"
		oDispatcher.executeDispatch(oFrame, ".uno:GoDownBlockSel", "", 0, Array())
		msgbox "Page Down Area Selected",0,"表示画面Areaの選択"
	' Page Left
		oDispatcher.executeDispatch(oFrame, ".uno:GoLeftBlockSel", "", 0, Array())
		msgbox "Page Left Area Selected",0,"表示画面Areaの選択"
	' Page Up
		oDispatcher.executeDispatch(oFrame, ".uno:GoUpBlockSel", "", 0, Array())
		msgbox "Page Up Area Selected",0,"表示画面Areaの選択"
	' Page Right
		oDispatcher.executeDispatch(oFrame, ".uno:GoRightBlockSel", "", 0, Array())
		msgbox "Page Right Area Selected",0,"表示画面Areaの選択"
End Sub

CCSel-)[Calc]「データベース範囲の選択」Dialogの表示


Sub UnoSelection()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:SelectDB", "", 0, Array())
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCSel-)[Calc]SHeetのSelection ⇔ Select Sheet(3)


Sub SheetSelection()
	Dim oDoc as Object, oCtrl as Object
	Dim oSelRange as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oSelRange = oCtrl.getActiveSheet()
		oCtrl.select( oSelRange )
		'
	msgbox "Success",0,"LO6.4.3.2(x64)"
End Sub

CCSel-)[Calc]


[ Address ]

CCA-)[Calc]Current CellのAddress取得(1)


Sub AddressOfCell()
	Dim oDoc as Object
	Dim oSel as Object
	Dim oActCol as Long, oActRow as Long
	Dim oShtNo as Integer
		oDoc = ThisComponent
		oSel = oDoc.CurrentController.getSelection()
		oActCol = oSel.getRangeAddress().StartColumn
		oActRow = oSel.getRangeAddress().StartRow
		oShtNo = oSel.getRangeAddress().Sheet
		'
		oDisp = "[ Current Cell ]" & Chr$(10) & "Sheet No. =" & oShtNo & Chr$(10) & "Address = ( " & oActCol & " , " & oActRow & " )"
		msgbox(oDisp,0,"Address of Cell")
End Sub

CCA-)[Calc]Current CellのAddress取得(2)


Sub AddressOfCell()
	Dim oDoc as Object
	Dim oSel as Object
	Dim oCellAddr as Object
	Dim oActCol as Long, oActRow as Long
	Dim oShtNo as Integer
		oDoc = ThisComponent
		oSel = oDoc.CurrentController.getSelection()
		oCellAddr = oSel.getCellAddress()	
		oActCol = oCellAddr.Column
		oActRow = oCellAddr.Row
		oShtNo = oCellAddr.Sheet
		'
		oDisp = "[ Current Cell ]" & Chr$(10) & "Sheet No. = " & oShtNo & CHr$(10) & "Address = ( " & oActCol & " , " & oActRow & " )"
		msgbox(oDisp,0,"Address of Cell")
End Sub
'
' [ Note ]
' Current selection が Areaの場合、Error になる。

CCA-)[Calc]名前で指定したCellのAddress取得


Sub AddressOfCell()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCellRange as Object
	Dim oCol as Long, oRow as Long
	Dim oShtNo as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCellRange = oSheet.getCellRangeByName("B3_Sheet1")		' OOo3.0 では getCellByName() method があったが 3.4 以降は使用不可
		'
		' oCellRange がAreaの場合は不可 / getCellRangeAddress 使用
		oCol = oCellRange.getCellAddress.Column
		oRow = oCellRange.getCellAddress.Row
		oShtNo = oCellRange.getCellAddress.Sheet
		'
		oDisp = "[ Address of Cell ]" & Chr$(10) & "Sheet No = " & oShtNo & Chr$(10) & _
					"Address = ( " & oCol &  " , " & oRow & " )"
		msgbox(oDisp,0,"Address of Cell")
End Sub

CCA-)[Calc]Current Cellの絶対Address取得(1)


Sub oRetrieveTheActiveCell
	Dim oDoc as Object
	Dim oldSelection as Object
	Dim oRange as Object
	Dim oActiveCell as Object
	Dim oConv as Object
		oDoc = ThisComponent
		oldSelection = oDoc.CurrentSelection
		oRange = oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
		oDoc.CurrentController.Select(oRange)
		' Get the active cell
			oActiveCell = oDoc.CurrentSelection
			oConv = oDoc.createInstance("com.sun.star.table.CellAddressConversion")
			oConv.Address = oActiveCell.getCellAddress
			oUI  = oConv.UserInterfaceRepresentation
			oPS = oConv.PersistentRepresentation
			oDisp = "[  UserInterfaceRepresentation  ]" & CHr$(10) & Chr$(9) & oUI & Chr$(10) & Chr$(10)
			oDisp = oDisp & "[  PersistentRepresentation  ]" & CHr$(10) & Chr$(9) & oPS & Chr$(10) 
		msgbox(oDisp, 0, "Representation")
		oDoc.CurrentController.Select(oldSelection)			 
End Sub

CCA-)[Calc]Current Cellの絶対Address取得(2)


Sub ActiveCellName()
	Dim oDoc as Object
	Dim oActiveCell as Object
	Dim oAbsName as String
		oDoc = ThisComponent
		oActiveCell = oDoc.CurrentSelection
		oAbsName = oActiveCell.AbsoluteName
		oDisp = "[ AbsoluteName  ]" & Chr$(10) & oAbsName
		msgbox(oDisp, 0, "Current Cell")			 
End Sub

CCA-)[Calc]選択範囲の最初と最後の行と列番号を取得

Sub Main
	Dim oCell As Object
		oCell = ThisComponent.CurrentController.getSelection()
		With oCell.RangeAddress
			MsgBox "Sheet: " & .Sheet & Chr(10) & _
				"StartColumn: " & .StartColumn & Chr(10) & _
				"StartRow:" & .StartRow & Chr(10) & _
				"EndColumn: " & .EndColumn & Chr(10) & _
				"EndRow: " & .EndRow
		End With
End Sub

CCA-)[Calc]最終行の取得


Sub CellAddress()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCursor as Object
	Dim oCntrl as Object
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(1) as new com.sun.star.beans.PropertyValue
	Dim oShtEndRow as Long
	Dim oEndRow as Long
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCursor = oSheet.createCursor()
		oShtEndRow  = oCursor.getRangeAddress().EndRow
		'
		oCntrl = oDoc.getCurrentController()
		oFrame = oCntrl.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "$A$" & oShtEndRow
		oProp(1).Name = "Sel"
		oProp(1).Value = false
		oDispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, oProp())
		'
		oProp(0).Name = "By"
		oProp(0).Value = 1
		oProp(1).Name = "Sel"
		oProp(1).Value = false
		oDispatcher.executeDispatch( oFrame, ".uno:GoUpToStartOfData", "", 0, oProp())
		oEndRow = oCntrl.getSelection().getRangeAddress().EndRow
		'
		oDisp = "[ Address of End Row ]" & Chr$(10) & "End Row  = " & oEndRow
		' Display
		msgbox(oDisp,0,"最終行取得")
End Sub

CCA-)[Calc]列番号を数字から英字へ変換

Sub oColumnNumberToString
	Dim oColumnString(5)
	Dim nColumn(5) As Long
		nColumn(0) = 0
		nColumn(1) = 5
		nColumn(2) = 10
		nColumn(3) = 15
		nColumn(4) = 20
		nColumn(5) = 25
		for i= 0 to UBound(nColumn)
			oColumnString(i) = Chr$(65+ (nColumn(i) MOD 26))
			oDisp = oDisp & nColumn(i) & " => " & oColumnString(i) & Chr$(10)
		next i
		msgbox(oDisp ,0, "Column No => String")
End Sub

CCA-)[Calc]列番号を数字から英字へ変換(2)

Function ColumnName ( ByVal ColumnNo As Long ) As String
    If ColumnNo / 26 > 1 then
        ColumnName = Chr ( 65 + int( ColumnNo / 26 ) - 1 ) & Chr( 65 + ColumnNo MOD 26 )
    Else
        ColumnName = Chr ( 65 + ColumnNo MOD 26 )
    End If
End Function

CCA-)[Calc]Cell Addressの変換/(0,0)→A1


Sub CellAddrConv()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oConv as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oConv = oDoc.createInstance("com.sun.star.table.CellAddressConversion")
		oCell = oSheet.getCellByPosition(0,0)			' Sheet1 / Cell A1
		oConv.Address = oCell.getCellAddress()
		oDisp = "Sheet1.(0,0) → " & oConv.PersistentRepresentation
	msgbox(oDisp,0,"Conversion")
End Sub

CCA-)[Calc]Data Areaの最初と最後のCell Address取得


Sub StartEndRowNo()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oFirstCell as Object
	Dim oCursor as Object
	Dim oFristRow as Long, oFirstCol as Long
	Dim oStartRow as Long, oEndRow as Long
	Dim oStartCol as Long, oEndCol as Long
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		'
		oFirstCol = 2
		oFristRow = 0
		oDisp = "[ Case1 ]" & Chr$(10) & "First Cell = ( " & oFirstCol & " , " & oFristRow & " )[ C1 ]" & Chr$(10)
		'
		oFirstCell = oSheet.getCellByPosition(oFirstCol, oFristRow)					' C1 Cell
		if oFirstCell.getType() = com.sun.star.table.CellContentType.EMPTY then
			oDisp = oDisp & "First Rowが空白です。"
		else
			oCursor = oSheet.createCursorByRange(oFirstCell)
			oCursor.gotoStart()		' Dataの始まりへ
			oStartCol = oCursor.getRangeAddress.StartColumn			' １つしかCellを選択していないので、 .EndColumn でも同じ
			oStartRow = oCursor.getRangeAddress.EndRow				' １つしかCellを選択していないので、 .StartRow でも同じ
  			oCursor.gotoEnd()		' Dataの最後へ
  			oEndCol = oCursor.getRangeAddress.StartColumn			' １つしかCellを選択していないので、 .StartColumn でも同じ
  			oEndRow = oCursor.getRangeAddress.EndRow				' １つしかCellを選択していないので、 .EndColumn でも同じ
  			oDisp = oDisp & "Column  : " & oStartCol & " ～ " & oEndCol & Chr$(10) & _
  									"Row       : " & oStartRow & " ～ " & oEndRow
		end if
		'
		oFirstCol = 2
		oFristRow = 4
		oDisp = oDisp & Chr$(10) & Chr$(10) & "[ Case2 ]" & Chr$(10) & "First Cell = ( " & oFirstCol & " , " & oFristRow & " )[ C5 ]" & Chr$(10)
		'
		oFirstCell = oSheet.getCellByPosition(oFirstCol, oFristRow)					' C5 Cell
		if oFirstCell.getType() = com.sun.star.table.CellContentType.EMPTY then
			oDisp = oDisp & "First Rowが空白です。"
		else
			oCursor = oSheet.createCursorByRange(oFirstCell)
			oCursor.gotoStart()		' Dataの始まりへ
			oStartCol = oCursor.getRangeAddress.StartColumn			' １つしかCellを選択していないので、 .EndColumn でも同じ
			oStartRow = oCursor.getRangeAddress.EndRow				' １つしかCellを選択していないので、 .StartRow でも同じ
  			oCursor.gotoEnd()		' Dataの最後へ
  			oEndCol = oCursor.getRangeAddress.StartColumn			' １つしかCellを選択していないので、 .StartColumn でも同じ
  			oEndRow = oCursor.getRangeAddress.EndRow				' １つしかCellを選択していないので、 .EndColumn でも同じ
  			oDisp = oDisp & "Column  : " & oStartCol & " ～ " & oEndCol & Chr$(10) & _
  									"Row       : " & oStartRow & " ～ " & oEndRow
		end if
		'
		oFirstCol = 2
		oFristRow = 8
		oDisp = oDisp & Chr$(10) & Chr$(10) & "[ Case3 ]" & Chr$(10) & "First Cell = ( " & oFirstCol & " , " & oFristRow & " )[ C9 ]" & Chr$(10)
		'
		oFirstCell = oSheet.getCellByPosition(oFirstCol, oFristRow)					' C5 Cell
		if oFirstCell.getType() = com.sun.star.table.CellContentType.EMPTY then
			oDisp = oDisp & "First Rowが空白です。"
		else
			oCursor = oSheet.createCursorByRange(oFirstCell)
			oCursor.gotoStart()		' Dataの始まりへ
			oStartCol = oCursor.getRangeAddress.StartColumn			' １つしかCellを選択していないので、 .EndColumn でも同じ
			oStartRow = oCursor.getRangeAddress.EndRow				' １つしかCellを選択していないので、 .StartRow でも同じ
  			oCursor.gotoEnd()		' Dataの最後へ
  			oEndCol = oCursor.getRangeAddress.StartColumn			' １つしかCellを選択していないので、 .StartColumn でも同じ
  			oEndRow = oCursor.getRangeAddress.EndRow				' １つしかCellを選択していないので、 .EndColumn でも同じ
  			oDisp = oDisp & "Column  : " & oStartCol & " ～ " & oEndCol & Chr$(10) & _
  									"Row       : " & oStartRow & " ～ " & oEndRow
		end if
		'
  		msgbox(oDisp,0,"最初と最後のAddress取得")
End Sub
'
' Refer to " Sheet操作/ Sheet Cursors / Simple Cursor Movement(1) "

CCA-)[Calc]Sheetの最初と最後のCell Address取得


Sub CellAddress()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCursor as Object
	Dim oShtFirstCol as Long, oShtFirstRow as Long
	Dim oShtEndCol as Long, oShtEndRow as Long
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCursor = oSheet.createCursor()
		'
		oDisp = "[ Cell Address of Sheet ]" & Chr$(10)
		'
		oShtFirstCol = oCursor.getRangeAddress().StartColumn
		oShtFirstRow  = oCursor.getRangeAddress().StartRow
		'
		oShtEndCol = oCursor.getRangeAddress().EndColumn
		oShtEndRow  = oCursor.getRangeAddress().EndRow
		oDisp = oDisp & "First Cell  = ( " & oShtFirstCol & " , " & oShtFirstRow & " )" & Chr$(10) & _
								" End Cell = (  " & oShtEndCol & " , " & oShtEndRow & " )"
		' Display
		msgbox(oDisp,0,"Sheetの最初と最後のCell Address")
End Sub
'
' Refer to " Sheet操作/ Sheet Cursors / Simple Cursor Movement(2) "

CCA-)[Calc]








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

inserted by FC2 system