Home of site


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

Calc No.2

###【 Previous Page ( Calc No.1 ) 】###


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

Cell操作(2)


[ Column・Row(行・列) ]


[ HyperLink(ハイパーリンク) ]


[ Array ]


[ Sort(並び替え) ]


[ Filter ]


[ Search ]


[ Merge(結合) ]


[ Calc Function ]


[ Subtotal of Column ]


[ 入力規則 / 条件付き書式 ]


[ 連続Data / Fill ]


[ Recalcuation( 再計算 ) ]


[ AutoInput(オートインプット) ]


[ Consolidate(統合) ]


[ Tokens ]


[ Name Range ]


Query[ com.sun.star.sheet.XCellRangesQuery Inteface( LibreOffice / Apache OpenOffice ) ]





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











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

Cell操作(2)


[ Column・Row(行・列) ]

CCR-)[Calc]行の挿入(1)

sub Main()
	Dim oDoc as Object
		oDoc=ThisComponent
		oSheet=oDoc.Sheets(0)
		oRows = oSheet.getRows()
		oRows.insertByIndex(16,3) '←17行目から3行挿入
End Sub

CCR-)[Calc]行の挿入(2)

Sub UnoInsertRow()
    Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "3:5" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame,  ".uno:InsertRows", "", 0, Array())
		'
		msgbox "Success"
End Sub

CCR-)[Calc]列の挿入(1)

sub Main()
	Dim oDoc as Object
		oDoc=ThisComponent
		oSheet=oDoc.Sheets(0)
		oColumns = oSheet.getColumns()
		oColumns.insertByIndex(2,3) '←C列目から3列挿入
End Sub

CCR-)[Calc]列の挿入(2)

Sub UnoInsertCol()
    Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "B:D" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame,  ".uno:InsertColumns", "", 0, Array())
		'
		msgbox "Success"
End Sub

CCR-)[Calc]行の削除(1)

sub Main()
	Dim oDoc as Object, oSheet as Object
	Dim oRows as Object
		oDoc=ThisComponent
		oSheet=oDoc.Sheets(0)
		oRows = oSheet.getRows()
		oRows.removeByIndex(0,10) '←1行目から10列削除
End Sub

CCR-)[Calc]行の削除(2)

Sub UnoDeleteRow()
    Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "2:4" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame,  ".uno:DeleteRows", "", 0, Array())
		'
		msgbox "Success"
End Sub

CCR-)[Calc]列の削除(1)

Sub Main()
	Dim oDoc as Object, oSheet as Object
	Dim oCols as Object
		oDoc = ThisComponent
		oSheet = oDoc.Sheets(0)
		oCols = oSheet.getColumns()
		oCols.removeByIndex(1, 4) '← B列から4列削除
		msgbox "Success"
End Sub

CCR-)[Calc]列の削除(2)

Sub UnoDeleteCol()
    Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "B:D" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame,  ".uno:DeleteColumns", "", 0, Array())
		'
		msgbox "Success"
End Sub

CCR-)[Calc]Cellの高さ値&幅値を取得

Sub Height_Width_1
	Dim oDoc As Object
	Dim oCell As Object
		oDoc=ThisComponent
		oSheet=oDoc.sheets(0)
		oCell=oSheet.getCellByPosition(0,0)
		Unit_Hieght=oCell.getRows().Height
		Unit_Width=oCell.getColumns().Width
End Sub

CCR-5)[Calc]全ての行高さ&列幅を設定する。

Sub Height_Width_2
  oDoc = ThisComponent
  oSheet = oDoc.getSheets().getByIndex(0)
  oRows = oSheet.Rows
  oColumns = oSheet.Columns
  oRows.Height=1000 '全ての行高さ=1cm
  oColumns.Width=5000 '全ての列幅=5cm
End Sub

CCR-)[Calc]行高さ&列幅を設定(1)

Sub Height_Width_3()
	Dim oDoc as Object, oSheet as Object
		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByIndex(0)
  		oSheet.Rows(0).Height=5000 '1行目の高さ=5cm
  		oSheet.Columns(1).Width=1000 'B列目の幅=1cm
End Sub

CCR-)[Calc]列高さ&列幅を設定(2)


Sub UnoOptimalColRow()
    Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "1:1" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oProp(0).Name = "RowHeight"
		oProp(0).Value = 2000		' 20mm
		oDispatcher.executeDispatch(oFrame,  ".uno:RowHeight", "", 0, oProp())
		msgbox "Set Row Height",0,"Set row and column"
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "B:B" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oProp(0).Name = "ColumnWidth"
		oProp(0).Value = 1000
		oDispatcher.executeDispatch(oFrame,  ".uno:ColumnWidth", "", 0, oProp())
		msgbox "Set Colwmn Width",0,"Set row and column"
End Sub

CCR-)[Calc]行高さ&列幅の最適化(1)


Sub ColRowOptimaize()
	Dim oDoc as Object, oSheet as Object
  		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByIndex(0)
  		oSheet.getColumns.OptimalWidth = true
  		oSheet.getRows.OptimalHeight = true
	msgbox "Success"
End Sub


CCR-)[Calc]行高さ&列幅の最適化(2)


Sub UnoOptimalColRow()
    Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A:A" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		' 引数を省略すると最適な列幅Dialogが表示される。
		oProp(0).Name = "aExtraWidth"
		oProp(0).Value = 0
		oDispatcher.executeDispatch(oFrame,  ".uno:SetOptimalColumnWidth", "", 0, oProp())
		msgbox "Optimal Colwmn Width",0,"Optimize"
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "1:2" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oProp(0).Name = "aExtraHeight"
		oProp(0).Value = 0
		oDispatcher.executeDispatch(oFrame,  ".uno:SetOptimalRowHeight", "", 0, oProp())
		msgbox "Optimal Row Height",0,"Optimize"
End Sub

CCR-)[Calc]列幅の最適化(3)


Sub UnoOptimalColRow()
    Dim oDoc as Object, oCtrl as Object, oFrame as Object
    Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A:A" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame,  ".uno:SetOptimalColumnWidthDirect", "", 0, Array())
		msgbox "Optimal Colwmn Width( Direct )",0,"Optimize"
End Sub
'
' [ Note ]
' Columnのみ有効
' Row高さ用の .uno:SetOptimalRowHeightDirect と言うCommandは無い

CCR-)[Calc]選択範囲を新しい場所に行と列を入れ替えて貼り付ける(String型)


Sub CopyRowReplaceColString()
    Dim oDoc as Object, oSheet as Object
    Dim document as object, dispatcher as object
    Dim oCellD as object
    Dim oCopyRange as string
    Dim oRangeDest as string
    Dim args1(0) as new com.sun.star.beans.PropertyValue
    Dim args2(5) as new com.sun.star.beans.PropertyValue
    	oDoc = ThisComponent
    	oSheet = oDoc.getSheets().getByIndex(0)
    	document   = oDoc.CurrentController.Frame
    	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    	'
    	oCopyRange = "A1:C3"	' 列と行の数は一致させる
    	oRangeDest = "D4:F6"	' 列と行の数は一致させる
		'
    	oCellD = oSheet.getCellRangeByName(oCopyRange)   
    	oDoc.getCurrentController().select(oCellD)   
		'
    	args1(0).Name = "ToPoint"
    	args1(0).Value = oCopyRange
   		'
    	dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
    	dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
   		'
    	args2(0).Name = "Flags"
    	args2(0).Value = "SVD"
    	args2(1).Name = "FormulaCommand"
    	args2(1).Value = 0
    	args2(2).Name = "SkipEmptyCells"
    	args2(2).Value = false
    	args2(3).Name = "Transpose"
    	args2(3).Value = true
    	args2(4).Name = "AsLink"
    	args2(4).Value = false
    	args2(5).Name = "MoveMode"
    	args2(5).Value = 4
    	oCellD = oSheet.getCellRangeByName(oRangeDest)
    	oDoc.getCurrentController().select(oCellD)
    	dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args2())
    	msgbox "Success"
End Sub

CCR-9)[Calc]選択範囲を新しい場所に行と列を入れ替えて貼り付ける(Object型)

Sub subCopyRowReplaceColObject(oCopyRange as Object,oRangeDest as Object)
    dim dispatcher as object
    dim document   as object
    dim args1(5) as new com.sun.star.beans.PropertyValue
    document   = ThisComponent.CurrentController.Frame
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    ThisComponent.getCurrentController().select(oCopyRange)   
    dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
  args1(0).Name = "Flags"
    args1(0).Value = "SVD"
    args1(1).Name = "FormulaCommand"
    args1(1).Value = 0
    args1(2).Name = "SkipEmptyCells"
    args1(2).Value = false
    args1(3).Name = "Transpose"
    args1(3).Value = true
    args1(4).Name = "AsLink"
    args1(4).Value = false
    args1(5).Name = "MoveMode"
    args1(5).Value = 4
  ThisComponent.getCurrentController().select(oRangeDest)
    dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args1())
End Sub

CCR-)[Calc]行と列の表示/非表示後(1)


Sub HideVisible()
	Dim oDoc as Object, oSheet as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Invisible
		oSheet.Rows(1).isVisible = False
		oSheet.Columns(2).isVisible = False
		msgbox "2行とC列を非表示化", 0, "非表示"
		' Visible
		oSheet.Rows(1).isVisible = True
		oSheet.Columns(2).isVisible = True
		msgbox "2行とC列を表示化", 0, "表示"
End Sub


CCR-)[Calc]行と列の表示/非表示後(2)


Sub HideVisible()
	Dim oDoc as Object, oSheet as Object
	Dim oRow as Object, oCol as Object
	Dim oRowRng as Object, oColRng as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("Sheet1")
		' Invisible
		oRow = oSheet.getRows()
		oCol = oSheet.getColumns()
		' Invisible
		for i = 1 to 4
			oRowRng = oRow.getByIndex(i)
			oColRng = oCol.getByIndex(i)
			oRowRng.isVisible = False
			oColRng.isVisible = False
		next i
		msgbox "2~5行とB~E列を非表示化", 0, "非表示"
		' Visible
		for i = 1 to 4
			oRowRng = oRow.getByIndex(i)
			oColRng = oCol.getByIndex(i)
			oRowRng.isVisible = True
			oColRng.isVisible = True
		next i
		msgbox "2~5行とB~E列を表示化", 0, "表示"
End Sub

CCR-)[Calc]行と列の表示/非表示後(3)

Sub UnoHideVisible()
    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 oSelRange as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Invisible
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "2:4"			' 2~4行 ⇒  Not 1~3 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame,  ".uno:HideRow", "", 0, Array())
		msgbox "2~4を非表示化" & Chr$(10) & "( DispatchHelper ) ", 0, "非表示"
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "B:D" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame,  ".uno:HideColumn", "", 0, Array())
		msgbox "2~4行とB~D列を非表示化" & Chr$(10) & "( DispatchHelper ) ", 0, "非表示"
		'
		' Visible
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "2:4" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame,  ".uno:ShowRow", "", 0, Array())
		msgbox "2~4行を表示化" & Chr$(10) & "( DispatchHelper ) ", 0, "表示"
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "B:D" 
		oDispatcher.executeDispatch(oFrame,  ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame,  ".uno:ShowColumn", "", 0, Array())
		msgbox "B~D列を表示化" & Chr$(10) & "( DispatchHelper ) ", 0, "表示"
End Sub



CCR-)[Calc]行高さ調整機能を無効化

Sub oIsAjustHiehgt
	Dim oDoc As Object
		oDoc=ThisComponent
		oCell=oDoc.Sheets(0).getCellByPosition(0,0)
		oCell.String = "LibreOffice マクロマニュアル"
		oCell.IsTextWrapped = true
		' Rowを選択してDouble ClickしてもRow高さを変更されない様にする。
		oDoc.IsAdjustHeightEnabled = false
		msgbox "Success"
End Sub

CCR-)[Calc]列のGroup化(1)

Sub ColRow()
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "$B:$C"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
		oProp(0).Name = "RowOrCol"
		oProp(0).Value = "C"
		oDispatcher.executeDispatch(oFrame, ".uno:Group", "", 0, oProp())
		msgbox("Goup化 OK",0,"Display")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "$B:$C"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
		oProp(0).Name = "RowOrCol"
		oProp(0).Value = "C"
		oDispatcher.executeDispatch(oFrame, ".uno:Ungroup", "", 0, oProp())
		msgbox("Goup化解除 OK",0,"Display")
End Sub

CCR-)[Calc]列のGroup化(2)

Sub ColRow()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCellAdr as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		'
		oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr
			.Sheet = 0
  			.StartColumn = 1		' Column B
  			.EndColumn = 2			' Column C
		end with
		oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.COLUMNS )
		msgbox("Goup化 OK",0,"Display")
		'
		oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr
			.Sheet = 0
  			.StartColumn = 1		' Column B
  			.EndColumn = 2			' Column C
		end with
		oSheet.ungroup( oCellAdr, com.sun.star.table.TableOrientation.COLUMNS )
		msgbox("Goup化解除 OK",0,"Display")
End Sub

CCR-)[Calc]行のGroup化(1)

Sub ColRow()
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "$3:$5"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
		oProp(0).Name = "RowOrCol"
		oProp(0).Value = "R"
		oDispatcher.executeDispatch(oFrame, ".uno:Group", "", 0, oProp())
		msgbox("Goup化 OK",0,"Display")
		'
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "$3:$5"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		'
		oProp(0).Name = "RowOrCol"
		oProp(0).Value = "R"
		oDispatcher.executeDispatch(oFrame, ".uno:Ungroup", "", 0, oProp())
		msgbox("Goup化解除 OK",0,"Display")
End Sub

CCR-)[Calc]行のGroup化(2)

Sub ColRow()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCellAdr as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		'
		oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr
			.Sheet = 0
  			.StartRow = 2			' Row No.3
  			.EndRow = 4			' Row No.4
		end with
		oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
		msgbox("Goup化 OK",0,"Display")
		'
		oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr
			.Sheet = 0
  			.StartRow = 2			' Row No.3
  			.EndRow = 4			' Row No.4
		end with
		oSheet.ungroup( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
		msgbox("Goup化解除 OK",0,"Display")
End Sub

CCR-)[Calc]Sheet内の全てのGoup化の削除

Sub ColRow()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCellAdr as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		'
		oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr
			.Sheet = 0
			' 1つ目のGroup
			.StartColumn = 1
			.EndColumn = 2
			' 2つ目のGropu
  			.StartRow = 2			' Row No.3
  			.EndRow = 4			' Row No.4
		end with
		oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.COLUMNS )
		oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
		msgbox("Goup化 OK",0,"Display")
		'
		oSheet.clearOutline()
		msgbox("全てのGoup化解除 OK",0,"Display")
End Sub

CCR-)[Calc]Sheet内の全てのGoup化の削除(2)

Sub ColRow()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCellAdr as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		'
		oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr
			.Sheet = 0
			' 1つ目のGroup
			.StartColumn = 1
			.EndColumn = 2
			' 2つ目のGropu
  			.StartRow = 2			' Row No.3
  			.EndRow = 4			' Row No.4
		end with
		oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.COLUMNS )
		oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
		msgbox("Goup化 OK",0,"Display")
		'
	' Group化の削除
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp()
		oFrame = oDoc.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Outlineの削除
		oDispatcher.executeDispatch(oFrame,  ".uno:ClearOutline", "", 0, oProp())
		msgbox("全てのGoup化解除 OK",0,"Display")
End Sub

CCR-)[Calc]Goupの表示/非表示

Sub ColRow()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCellAdr as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		'
		oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr
			.Sheet = 0
			' 1つ目のGroup
			.StartColumn = 1
			.EndColumn = 2
			' 2つ目のGropu
  			.StartRow = 2			' Row No.3
  			.EndRow = 4			' Row No.4
		end with
		oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.COLUMNS )
		oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
		msgbox("Goup化 OK",0,"Display")
		'
		oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr
			.Sheet = 0
			' 1つ目のGroup
			.StartColumn = 1
			.EndColumn = 2
		end with
		oSheet.hideDetail( oCellAdr )
		msgbox("Goup部の非表示化 OK",0,"Display")
		'
		oSheet.ShowDetail( oCellAdr )
		msgbox("Goup部の表示化 OK",0,"Display")
End Sub

CCR-)[Calc]Outlineの自動作成

Sub ColRow()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCellAdr as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		'
		oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr
			.Sheet = 0
  			.StartRow = 1			' ← 正確な範囲指定は不要
  			.EndRow = 10			' ←  但し、範囲内に無いDataは 自動Outline(Group化)は作成されない
		end with
		' Outlineの自動作成
		oSheet.autoOutline(oCellAdr)
		msgbox("Outlineの自動作成 → OK",0,"Outline")
		'
		' Outlineの削除
		oSheet.clearOutline()
		msgbox("全てのGoup化解除 OK",0,"Display")
End Sub
'
' Outlineの自動作成については http://help.libreoffice.org/Calc/AutoOutline/ja を参照 
'
' [ 注意 ]
' = Sum(A1:A3) → OK
' = A1 + A2 + A3 → NG
'
















CCR-)[Calc]Outlineの自動作成(2)

Sub ColRow()
	Dim oFrame as Object
	Dim oDispatcher as Object
	Dim oProp()
		oFrame = ThisComponent.CurrentController.Frame
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' Outlineの自動作成
		oDispatcher.executeDispatch(oFrame,  ".uno:AutoOutline", "", 0, oProp())
		msgbox("Outlineの自動作成 → OK",0,"Outline")
		'
		' Outlineの削除
		oDispatcher.executeDispatch(oFrame,  ".uno:ClearOutline", "", 0, oProp())
		msgbox("Outlineの削除 → OK",0,"Outline")
End Sub

CCR-)[Calc]任意Levelまで一度に表示


Sub ColRow()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCellAdr1 as Object
	Dim oCellAdr2 as Object
	Dim oCellAdr3 as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		'
		oCellAdr1 = createUnoStruct("com.sun.star.table.CellRangeAddress")
		' 1 Level目のGroup作成
		with oCellAdr1
			.Sheet = 0
  			.StartRow = 0
  			.EndRow = 10
		end with
		oSheet.group( oCellAdr1, com.sun.star.table.TableOrientation.ROWS )
		'
		' 2 Level目のGroup作成
		oCellAdr2 = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr2
			.Sheet = 0
  			.StartRow = 2
  			.EndRow = 8
		end with
		oSheet.group( oCellAdr2, com.sun.star.table.TableOrientation.ROWS )
		'
		' 3 Level目のGroup作成
		oCellAdr3 = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr3
			.Sheet = 0
  			.StartRow = 4
  			.EndRow = 5
		end with
		oSheet.group( oCellAdr3, com.sun.star.table.TableOrientation.ROWS )
		'
		' 3Level を非表示
		oSheet.hideDetail( oCellAdr3 )		' 範囲が小さいものから非表示化 / 手作業と同じ
		' 2Level を非表示
		oSheet.hideDetail( oCellAdr2 )
		' 1Level を非表示
		oSheet.hideDetail( oCellAdr1 )
		msgbox("Goupの非表示化完了",0,"Display")
		'
		' 2 Levelまで一度に表示
		oSheet.showLevel(2,com.sun.star.table.TableOrientation.ROWS)
		msgbox("2 Levelまで展開",0,"Display")
		'
		' Outlineの削除
		oSheet.clearOutline()
		msgbox("全てのGoup化解除 OK",0,"Display")
End Sub


[ HyperLink ]

CCH-)[Calc]HyperLink設定(1)


Sub HyperLinkCell()
	Dim document as Object, dispatcher as Object
	Dim name_HyperLink(0) as new com.sun.star.beans.PropertyValue
	Dim setHyperLinkArgs(2) as new com.sun.star.beans.PropertyValue
		document = ThisComponent.CurrentController.Frame
		dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'ハイパーリンクセット
		name_HyperLink(0).name="ToPoint"
		name_HyperLink(0).value="A1"		' ←HyperLink設定セル
		dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, name_HyperLink())
		setHyperLinkArgs(0).Name = "Hyperlink.Text"
		setHyperLinkArgs(0).value = "Yahoo Japan"
		setHyperLinkArgs(1).Name = "Hyperlink.URL"
		setHyperLinkArgs(1).Value ="http://www.yahoo.co.jp"
		setHyperLinkArgs(2).name="Hyperlink.Type"
		setHyperLinkArgs(2).value=1 
		dispatcher.executeDispatch(document, ".uno:SetHyperlink", "", 0, setHyperLinkArgs())
		msgbox "Success" & Chr$(10) & "(DispatchHelper)"
End Sub

CCH-)[Calc]HyperLink設定(2)


Sub HyperLinkCell()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oTextCursor as Object
	Dim oLink as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,0)
		'
		oLink = oDoc.createInstance("com.sun.star.text.TextField.URL")
		with oLink
			.URL = "http://ja.libreofficeforum.org/forum"
			.Representation = "LibreOffice Forum"
			.TargetFrame = "_blank"
		end with
		'
		oTextCursor = oCell.createTextCursor()
		oCell.insertTextContent( oTextCursor, oLink, false )
		'
	msgbox "Success"
End Sub
'
' [ TargetFrame ]
'   _blank
'   _parent
'   _self
'   _top

CCH-)[Calc]HyperLink設定(3)


Sub HyperLinkCell()
	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 Forum"
		oCell.Hyperlink = "http://ja.libreofficeforum.org/forum"
	msgbox "Success"
End Sub
'
' [ Note ]
' This code confirm with LibreOffice 4.2.2 and has error with Apache OpenOffice 4.0.1 


[ Array ]

CCD-)[Calc]配列の文字列を纏める

Sub Main5()
	Dim oItems(0 to 2) as String
	Dim str as String
		oItems(0)="123"
 		oItems(1)="abc"
 		oItems(2)="456"
 		str=Join(Items,"+")
 	Print str
End Sub

CCD-)[Calc]文字列を分割して、配列として返す。(CSV fileを扱うときに便利)

Sub Main4
	Dim Items()
 		Items=Split("Apple,Orange,Lemon",",")
 		Print Items(0),Items(1),Items(2)
End Sub

CCD-)[Calc]指定範囲のDataを全て取得

Sub oGetAndSetData
	Dim oRange
	Dim oSheet
	Dim oAllData
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:G10")
	'Get Data
		oAllData = oRange.getDataArray()
		for i = 0 to Ubound(oAllData)
			oDisp = oDisp & " " & Join(oAllData(i), " : ") & " " & Chr$(10)
		next i
	msgbox(oDisp,0,"Data In Range")
End Sub

CCD-)[Calc]指定範囲にDataを入力

Sub oGetAndSetData
	Dim oRange
	Dim oSheet
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:B2")
	'Set Data
		oRange.setDataArray(Array(Array("A1", "B1"), Array("A2", "B2")))
End Sub

CCD-)[Calc]Array Fourmula


Sub CalcArrayFormula()
	Dim oDoc as Object, oSheet as Object, oCell as Object 
	Dim oRange as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
	'Set the two top cells
		oCell = oSheet.getCellByPosition(1,2)
			oCell.setValue(1)
		oCell = oSheet.getCellByPosition(2,2)
			oCell.setValue(3)
	'Fill the Values Down
		oRange = oSheet.getCellRangeByName("B3:C8")
		oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, 1)
	'Setting each cell individually
		for i=3 to 8
			oCell = oSheet.getCellByPosition(3, i-1)
			oCell.setFormula("=B" & i & "+C" & i)
		next i
	'Setting a single array formula
		oRange = oSheet.getCellRangeByName("E3:E8")
		oRange.setArrayFormula("=B3:B8+C3:C8")
	'Title for Column
		oRange = oSheet.getCellRangeByName("B2:E2")
		oRange.setDataArray(Array(Array("B", "C", "Formula", "Array Formula")))
		'
		msgbox "Success",0,"Array Formula"
End Sub



[ Sort ]

CCS-)[Calc]指定範囲を任意の列の昇順でSort(1)


Sub DataSort()
	Dim oDoc as Object, oSheet as Object, oCell01 as Object, oCell02 as Object
	Dim oRange as Object
	Dim oCol as integer
	Dim oDescriptors_obj(1) As New com.sun.star.beans.PropertyValue
	Dim oSortFields(0) As New com.sun.star.util.SortField
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.getCellByPosition(0, 0).String = "Title01"
		oSheet.getCellByPosition(1, 0).String = "Title02"
		for i = 1 to 6
			oCell01 = oSheet.getCellByPosition(0, i)
			oCell02 = oSheet.getCellByPosition(1, i)
			if i = 2 then
				oCell01.String = "LibreOffice"
				oCell02.String = " ver4.2.2"
			else
				if i = 4 then
					oCell01.String = "AOO"
					oCell02.String = " ver4.0.1"
				else
					oCell01.Value = ( i + 1 ) * 10
					oCell02.Value = CInt(100 / i )
				end if
			end if
		next i
		msgbox "Before sort",0,"Sort"
		'
		' Col No
		oCol = 0
		oRange = oSheet.getCellRangeByName("A1:B100")
		oSortFields(0).Field = oCol
		oSortFields(0).SortAscending = True
		oDescriptors_obj(0).Name = "SortFields"
		oDescriptors_obj(0).Value = oSortFields()
		oDescriptors_obj(1).Name = "ContainsHeader"
		oDescriptors_obj(1).Value = True					' Falseにすると Title行までSort
		oRange.sort(oDescriptors_obj())
		msgbox "After sort",0,"Sort"
End Sub

CCS-)[Calc]指定範囲を任意の列の昇順でSort(2)


Sub DataSort()
	Dim oDoc as Object, oSheet as Object, oCell01 as Object, oCell02 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(8) As New com.sun.star.beans.PropertyValue
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSheet.getCellByPosition(0, 0).String = "Title01"
		oSheet.getCellByPosition(1, 0).String = "Title02"
		for i = 1 to 6
			oCell01 = oSheet.getCellByPosition(0, i)
			oCell02 = oSheet.getCellByPosition(1, i)
			if i = 5 then
				oCell01.String = "LibreOffice"
				oCell02.String = " ver4.2.2"
			else
				if i = 3 then
					oCell01.String = "AOO"
					oCell02.String = " ver4.0.1"
				else
					oCell01.Value = CInt(100 / i )
					oCell02.Value = ( i + 1 ) * 10
				end if
			end if
		next i
		msgbox "Before sort",0,"Sort"
		'
		oCtrl = oDoc.getCurrentController()
  		oFrame   = oCtrl.getFrame()
  		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  		oPreProp(0).Name = "ToPoint"
		oPreProp(0).Value = "A1:B100"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oPreProp())
  			oProp(0).Name = "ByRows"
  			oProp(0).Value = True
  			oProp(1).Name = "HasHeader"
  			oProp(1).Value = True
  			oProp(2).Name = "CaseSesitive"
  			oProp(2).Value = False
  			oProp(3).Name = "IncludeAttribs"
  			oProp(3).Value = True
  			oProp(4).Name = "UserDefindex"
  			oProp(4).Value = 0
  			' A列
  			oProp(5).Name = "Col1"
  			oProp(5).Value = 1			' 1 : A 列 / Not 0
  			oProp(6).Name = "Ascending1"
  			oProp(6).Value = True
  			' B列
  			oProp(7).Name = "Col2"
  			oProp(7).Value = 2
  			oProp(7).Name = "Ascending1"
  			oProp(7).Value = False
		oDispatcher.executeDispatch(oFrame, ".uno:DataSort", "", 0, oProp())
		msgbox "After sort",0,"Sort"
End Sub

CCS-1)[Calc]数字としてSort

Sub oShortColOne
	Dim oSheet
	Dim oRange
	Dim oSortFields(0) as new com.sun.star.util.SortField
	Dim oSortDesc(0) as new com.sun.star.beans.PropertyValue
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:A10")
			oSortFields(0).Field = 0
			oSortFields(0).SortAscending = true
			oSortFields(0).FieldType = com.sun.star.util.SortFieldType.NUMERIC
		oSortDesc(0).Name = "SortFields"
		oSortDesc(0).Value = oSortFields()
	oRange.Sort(oSortDesc())
End Sub

CCS-1)[Calc]Text DataとしてSort

Sub oShortColOne
	Dim oSheet
	Dim oRange
	Dim oSortFields(0) as new com.sun.star.util.SortField
	Dim oSortDesc(0) as new com.sun.star.beans.PropertyValue
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:A10")
			oSortFields(0).Field = 0
			oSortFields(0).SortAscending = true
			oSortFields(0).FieldType = com.sun.star.util.SortFieldType.ALPHANUMERIC
		oSortDesc(0).Name = "SortFields"
		oSortDesc(0).Value = oSortFields()
	oRange.Sort(oSortDesc())
End Sub

CCS-1)[Calc]Sort Descriptor


Sub oDisplaySortDescriptor
	On Error Resume Next
	Dim oSheet
	Dim oRange
	Dim oSortDescript()
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("B28:D33")
	oSortDescript = oRange.createSortDescriptor()	
		for i = LBound(oSortDescript) to UBound(oSortDescript)
			oDisp = oDisp & oSortDescript(i).Name & " = "
			oDisp = oDisp & oSortDEscript(i).Value
			oDisp = oDisp & Chr$(10)
		next
	msgbox(oDisp,0,"Sort Descriptor")
End Sub


[ Filter ]

CCFlt-)[Calc]AutoFilterの設定/解除(1)


Sub SetAutoFlter()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oDbRanges as Object
	Dim oRange as Object
	Dim oRangeName as String
	Dim oFilterRange as Object
  		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByIndex(0)
  		'
  		oDBRanges = oDoc.DatabaseRanges
  		oRange = oSheet.getCellRangeByPosition(0,0,1,1000)		' A1 ~ B1001
  		' AutoFilterを設定するRangeにNameを付ける( 必須 )
  		oRangeName = "RangeName"
 		'
 		' 同じRange Nameを付けようとするとCrashするので、同名Range Nameは一旦、削除する
 		If oDBRanges.hasByName(oRangeName) Then
   			oDBRanges.removeByName(oRangeName)
 		End If
 		' A1 ~ B1001の範囲にRange Nameを設定する
 		oDBRanges.addNewByName(oRangeName, oRange.RangeAddress)
 		' Range Objectを取得
 		oFilterRange = oDBRanges.getByName(oRangeName)
 		' AutoFilter 設定 ON
 		oFilterRange.AutoFilter = true
 		' Display
 		msgbox "AutoFilter設定完了"
 		'
 		' AutoFilter 解除
 		oFilterRange.AutoFilter = false
 		' Display
 		msgbox "AutoFilter解除完了"
End Sub

CCFlt-)[Calc]AutoFilterの設定/解除(2)


Sub UnoSetAutoFlter()
	Dim oDoc as Object, oSheet as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByIndex(0)
  		oCtrl = oDoc.getCurrentController()
  		oFrame   = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  		'
  		'まずオートフィルタの範囲を選択します。(アクティブなセルを指定)
		oCtrl.select (oSheet.getCellRangeByName ("A1:B1001"))
 		'オートフィルタ設定 ON
		oDispatcher.executeDispatch(oFrame, ".uno:DataFilterAutoFilter", "", 0, Array())
 		msgbox "AutoFilter設定完了",0,"AutoFilter"
 		'オートフィルタ設定 OFF
		oDispatcher.executeDispatch(oFrame, ".uno:DataFilterAutoFilter", "", 0, Array())
 		msgbox "AutoFilter設定解除",0,"AutoFilter"
End Sub

CCFlt-)[Calc]AutoFilterでFiltering


Sub SetAutoFlter()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oDbRanges as Object
	Dim oRange as Object
	Dim oRangeName as String
	Dim oFilterRange as Object
  		oDoc = ThisComponent
  		oSheet = oDoc.getSheets().getByIndex(0)
  		'
  		oDBRanges = oDoc.DatabaseRanges
  		oRange = oSheet.getCellRangeByPosition(0,0,1,1000)		' A1 ~ B1001
  		' AutoFilterを設定するRangeにNameを付ける( 必須 )
  		oRangeName = "RangeName"
 		'
 		' 同じRange Nameを付けようとするとCrashするので、同名Range Nameは一旦、削除する
 		If oDBRanges.hasByName(oRangeName) Then
   			oDBRanges.removeByName(oRangeName)
 		End If
 		' A1 ~ B1001の範囲にRange Nameを設定する
 		oDBRanges.addNewByName(oRangeName, oRange.RangeAddress)
 		' Range Objectを取得
 		oFilterRange = oDBRanges.getByName(oRangeName)
 		' AutoFilter 設定 ON
 		oFilterRange.AutoFilter = true
 		'
 	' AutoFilter Display
 	Dim oFilterDisp as Object
 		oFilterDisp = oFilterRange.FilterDescriptor
 		'
 	' FilterFieldの作成が必要		' FilterFieldsでは上手くいかない?
 	Dim oFilterItem(0) As New com.sun.star.sheet.TableFilterField		' AutoFilter では 条件Columnは1つしか無いので 0 だけらしい。
 		With oFilterItem(0)			
 			.Connection = com.sun.star.sheet.FilterConnection.AND		' com.sun.star.sheet.FilterConnection.OR でも同じらしい
    		.Field = 0
    		.Operator = com.sun.star.sheet.FilterOperator.EQUAL
    		.IsNumeric = true
    		.NumericValue = 5
 		End With
 	' Set
 		oFilterDisp.setFilterFields( oFilterItem )
 		'
  	' Filter 範囲の表示の更新
  		oFilterRange.refresh()
  		'
  	msgbox("設定1",0,"AutoFilterの設定")
  		'
  	' 2回目の設定
  		With oFilterItem(0)
 			.Connection = com.sun.star.sheet.FilterConnection.OR
    		.Field = 1
    		.Operator = com.sun.star.sheet.FilterOperator.EQUAL
    		.IsNumeric = false
    		.StringValue = "Taro"
 		End With
 		' Set
 		oFilterDisp.setFilterFields( oFilterItem )
 		'
  	' Filter 範囲の表示の更新
  		oFilterRange.refresh()
  		'
  	msgbox("設定2",0,"AutoFilterの設定")
End Sub

CCFlt-)[Calc]標準Filter設定Dialog表示


Sub UnoSetStdFlter()
	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")
  		' DIsplay Dialog
		oDispatcher.executeDispatch(oFrame, ".uno:DataFilterStandardFilter", "", 0, Array())
 		msgbox "Succcess",0,"Filter"
End Sub

CCFlt-)[Calc]特殊Filter設定Dialog表示


Sub UnoSetSpecialFlter()
	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")
  		' DIsplay Dialog
		oDispatcher.executeDispatch(oFrame, ".uno:DataFilterSpecialFilter", "", 0, Array())
 		msgbox "Succcess",0,"Filter"
End Sub

CCFlt-)[Calc]標準/特殊Filter解除(1)


Sub RemoveSheetFilter()
	Dim oDoc as Object, oSheet as Object
	Dim oFilterDesc as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
  		oFilterDesc = oSheet.createFilterDescriptor(True)
  		oSheet.filter(oFilterDesc)
  		msgbox "Success",0,"Remove Filter"
End Sub

CCFlt-)[Calc]標準/特殊Filter解除(2)


Sub UnoRemoveSheetFilter()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oSheet as Object
		oDoc = ThisComponent
  		oCtrl = oDoc.getCurrentController()
  		oFrame   = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		' Filter Area
		oSheet = oDoc.getSheets().getByIndex(0)
		oCtrl.select (oSheet.getCellRangeByName ("A1:C100"))
  		' Remove Filter
		oDispatcher.executeDispatch(oFrame, ".uno:DataFilterRemoveFilter", "", 0, Array())
 		msgbox "Succcess( Uno )",0,"Remove Filter"
End Sub

CCFlt-)[Calc]





[ Search ]

CCSh-)[Calc]Simple Search


Sub CalcSearchSht()
	Dim oDoc as Object, oSheet as Object
	Dim oSearch as Object, oFind as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oSearch = oSheet.createSearchDescriptor()
		With oSearch
			.SearchString = "LibreOffice"	' ← 検索文字
			.SearchWords = false 			' ← 検索文字が一部含まれる(false),絶対一致(true)。 大文字と小文字の区別無し
			.SearchCaseSensitive = false	' ← 大文字小文字区別( true )
		End With
		' Search
			oFind = oSheet.findFirst(oSearch)
			oDisp = oFind.getString()
		msgbox( oDisp )
End Sub


CCSh-)[Calc]Simple Replace

Sub oSearchSheet
	Dim oSheet
		oSheet = ThisComponent.Sheets(1)
		oSearch = oSheet.createReplaceDescriptor()
		With oSearch
			.SearchString = "newOoo3"				'	←		検索文字
			.ReplaceString = "OpenOffice.org"		'	←		置換文字
			.SearchWords = true 					'	←		検索文字が一部含まれる(false),絶対一致(true)。 大文字と小文字の区別無し
			.SearchCaseSensitive = false			'	←		大文字小文字区別( true )
		End With
		' Relace
			oDisp = oSheet.replaceAll(oSearch)
		msgbox( oDisp, 0, "置換した数" )
End Sub

CCSh-)[Calc]Cell内改行を検索


Sub oSearchSheet
	Dim oSheet
		oSheet = ThisComponent.Sheets(0)
		oSearch = oSheet.createSearchDescriptor()
		With oSearch
			REM  ' 検索は出来るが、任意の文字をCell内改行はほぼ出来ない。
			REM  ' 正確には置換しているが、Cell内改行されている様に表示されない。
			REM  ' 対象Cellを手動で選択するとセル内改行されている事が分る。
			.SearchString = Chr$(10)		
			.SearchWords = false 				'	←		検索文字が一部含まれる(false),絶対一致(true)。 大文字と小文字の区別無し
			.SearchCaseSensitive = false	'	←		大文字小文字区別( true )
		End With
		' Search
			oFind = oSheet.findFirst(oSearch)
			oDisp = oFind.getString()
		msgbox( oDisp )
End Sub

CCSh-)[Calc]前と同じ条件で再検索


Sub CalcSearch()
	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:RepeatSearch", "", 0, Array())
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
'
' [ Note ]
' 検索窓で検索した条件が用いられる。検索窓から検索しないと、検索対象は空白になる。


[ Merge ]

CCM-)[Calc]Cellの結合/結合解除(1)


Sub CellMerge()
	Dim oDoc as Object, oSheet as Object
	Dim oRange as Object
		oDoc = ThisComponent
		oSheet = oDoc.Sheets().getByIndex(0)
		oRange = oSheet.getCellRangeByName("A1:B2")
		'
		oRange.merge(true)
		msgbox "Merge cell",0,"Merge of Cell"
		'
		oRange.merge(false)
		msgbox "Split cell",0,"Merge of Cell"
End Sub

CCM-)[Calc]Cellの結合/結合解除(2)


Sub UnoMergeCell()
	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:B3"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		' Merge cells
		oDispatcher.executeDispatch(oFrame, ".uno:MergeCells", "", 0, Array())
		msgbox "Merge Cells" & Chr$(10) & "(DispatchHelper)",0,"Merge of Cell"
		' Split cell
		oDispatcher.executeDispatch(oFrame, ".uno:SplitCell", "", 0, Array())
		msgbox "Split Cell" & Chr$(10) & "(DispatchHelper)",0,"Merge of Cell"
End Sub

CCM-)[Calc]結合されたセル(事前に選択)のサイズを調べる(その1)

Sub UnoCellMerge()
	Dim oDoc as Object, oCtrl as Object, oFrame as Object
	Dim oDispatcher as object
	Dim oCell as Object
		oDoc = ThisComponent
		oCtrl = oDoc.getSheets().getByName("sheet1")
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispatcher.executeDispatch(oFrame, ".uno:ToggleMergeCells", "", 0, Array())
		oCell = ThisComponent.CurrentController.getSelection()
		cs=oCell.RangeAddress.StartColumn
		rs=oCell.RangeAddress.StartRow
		ce=oCell.RangeAddress.EndColumn
		re=oCell.RangeAddress.EndRow
		oWidth=0
		oHeight=0
		for i=cs to ce
			oW=ThisComponent.Sheets(0).getCellByPosition(i,0)
			oWidth_tmp=oW.getColumns().Width
			oWidth = oWidth + oWidth_tmp
		next
		for i=rs to re
			oH=ThisComponent.Sheets(0).getCellByPosition(0,i)
			oHeight_tmp=oH.getRows().Height
			oHeight= oHieght + oHeight_tmp
		next
		oDispatcher.executeDispatch(oFrame, ".uno:ToggleMergeCells", "", 0, Array())
		MsgBox("結合セルの幅 : " & oWidth &Chr(10) & _
				"結合セルの高さ : " & oHeight)
End Sub

CCM-)[Calc]結合されたセル(事前に選択)のサイズを調べる(その2)

Option VBASupport 1
Sub MergeCell2()
	Dim oSheet As Object
	Dim oCursor As Object
	Dim oSelection As Object
	Dim oWidth As Long
	Dim oHeight As Long
		oSheet =ThisComponent.CurrentController.ActiveSheet
		oSelection = ThisComponent.CurrentSelection
		oCursor = oSheet.createCursorByRange( oSelection )
		oCursor.collapseToMergedArea()
		oWidth = oCursor.Size.Width
		oHeight = oCursor.Size.Height
		MsgBox("結合セルの幅 : " & oWidth &Chr(10) & _
				"結合セルの高さ : " & oHeight)
End Sub

[ Note ] :(その1)と(その2)の違い
(その1) : セルの結合解除 ⇒ 選択範囲の各セルサイズ(幅、高さ)を取得 ⇒ 各セルサイズを足し合わせる ⇒ 再度セルの結合を実施
(その2) : 結合セルのAreaサイズを直接取得。(その1)に比べると少し調査精度が低いが、概略サイズの取得ならばこちらのコードの方がSmartである。

CCM-)[Calc]各Sheet内に結合しているセルがあるかどうか調べる。

Sub sheet_by_enumeration()
	Dim oSheetsEnumeration As Object, oSheets As Object
		oSheets = ThisComponent.getSheets()
		oSheetsEnumeration = oSheets.createEnumeration()
	While ( oSheetsEnumeration.hasMoreElements() )
		MsgBox oSheetsEnumeration.nextElement.IsMerged()
	WEnd
End Sub

[ Calc Function ]

CCFc-)[Calc]Find

Sub oFunction
	Dim oFunction(2)
		ShtFnc = CreateUnoService("com.sun.star.sheet.FunctionAccess") 
		oSource = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 			oFunction(0) = "T"
 			oFunction(1) = oSource
 			oFunction(2) = 1
 		oPosFind = ShtFnc.callFunction("Find", oFunction())+1
 	msgbox(oFunction(0) & " => " & oPosFind & " 文字目",0,"Calc Function")
End Sub

CCFc-)[Calc]値をValue形式にする

Sub oFunction
	Dim oFunction(0)
		ShtFnc = CreateUnoService("com.sun.star.sheet.FunctionAccess") 
			oFunction(0) = "1,234"
 		oPosFind = ShtFnc.callFunction("Value", oFunction())
 	msgbox(oFunction(0) & " → " & oPosFind ,0,"Calc Function")
End Sub

CCFc-)[Calc]値をText形式にする

Sub oFunction
	Dim oFunction(0)
		ShtFnc = CreateUnoService("com.sun.star.sheet.FunctionAccess") 
			oFunction(0) = "1,234"
 		oPosFind = ShtFnc.callFunction("T", oFunction())
 	msgbox(oFunction(0) & " => " & oPosFind ,0,"Calc Function")
End Sub

CCFc-)[Calc]指定範囲の合計(1)[連続範囲]


Sub UseComputeSum()
	Dim oRange as Object
	Dim oSheet as Object
	Dim oResult as double
		oSheet = ThisComponent.Sheets(0)
		oRange = oSheet.getCellRangeByName("A1:B5")				
		oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.SUM )
		oDisp = "A1:B5 => Sum = " & oResult & Chr$(10) & "文字列・空白は自動的に除外"
	msgbox(oDisp,0,"ComputerFunction")
End Sub
'
' [ Note ]
' 1) 範囲内に文字列、空白があってもOK。式値は含まれる。

CCFc-)[Calc]指定範囲の合計(2)[不連続範囲]


Sub UseComputeSum()
	Dim oRange(1) as Object
	Dim oSheet as Object
	Dim oResult as Double
		oSheet = ThisComponent.Sheets(0)
		oRange(0) = oSheet.getCellRangeByName("A1:A5")
		oRange(1) = oSheet.getCellRangeByName("D1:D5")
		oResult = 0
		for i = 0 to UBound(oRange)
		  oResult = oResult + oRange(i).computeFunction(com.sun.star.sheet.GeneralFunction.SUM )
		next i						
		oDisp = "A1:A5/D1:D5 → Sum = " & oResult & Chr$(10) & "文字列・空白は自動的に除外"
	msgbox(oDisp,0,"ComputerFunction")
End Sub

CCFc-)[Calc]空白以外のCell数

Sub oUseCompute
	Dim oRange
	Dim oSheet
	Dim oResult as double
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:B5")
		oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.COUNT )
		oDisp = "A1:B5 => COUNT = " & oResult & Chr$(10) & "空白以外のCell数"
	msgbox(oDisp,0,"ComputerFunction")
End Sub

CCFc-)[Calc]指定範囲の平均

Sub oUseCompute
	Dim oRange
	Dim oSheet
	Dim oResult as double
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:B5")
		oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.AVERAGE )
		oDisp = "A1:B5 => Average = " & oResult & Chr$(10) & "平均"
	msgbox(oDisp,0,"ComputerFunction")
End Sub

CCFc-)[Calc]最大値

Sub oUseCompute
	Dim oRange
	Dim oSheet
	Dim oResult as double
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:B5")
		oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.MAX )
		oDisp = "A1:B5 => MAX = " & oResult & Chr$(10) & "MAX値"
	msgbox(oDisp,0,"ComputerFunction")
End Sub

CCFc-)[Calc]最小値

Sub oUseCompute
	Dim oRange
	Dim oSheet
	Dim oResult as double
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:B5")
		oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.MIN )
		oDisp = "A1:B5 => MIN = " & oResult & Chr$(10) & "MIN値"
	msgbox(oDisp,0,"ComputerFunction")
End Sub

CCFc-)[Calc]Product

Sub oUseCompute
	Dim oRange
	Dim oSheet
	Dim oResult as double
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:B5")
		oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.PRODUCT )
		oDisp = "A1:B5 => PRODUCT = " & oResult & Chr$(10) & "PRODUCT値"
	msgbox(oDisp,0,"ComputerFunction")
End Sub

CCFc-)[Calc]数値Cellの数

Sub oUseCompute
	Dim oRange
	Dim oSheet
	Dim oResult as double
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:B5")
		oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.COUNTNUMS )
		oDisp = "A1:B5 => COUNTNUMS = " & oResult & Chr$(10) & "COUNTNUMS値"
	msgbox(oDisp,0,"ComputerFunction")
End Sub

CCFc-)[Calc]推定標準偏差

Sub oUseCompute
	Dim oRange
	Dim oSheet
	Dim oResult as double
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:B5")
		oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.STDEV )
		oDisp = "A1:B5 => STDEV = " & oResult & Chr$(10) & "STDEV値"
	msgbox(oDisp,0,"ComputerFunction")
End Sub

CCFc-)[Calc]標準偏差

Sub oUseCompute
	Dim oRange
	Dim oSheet
	Dim oResult as double
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:B5")
		oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.STDEVP )
		oDisp = "A1:B5 => STDEVP = " & oResult & Chr$(10) & "STDEVP値"
	msgbox(oDisp,0,"ComputerFunction")
End Sub

CCFc-)[Calc]標本に基づいて分散を予測

Sub oUseCompute
	Dim oRange
	Dim oSheet
	Dim oResult as double
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:B5")
		oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.VAR )
		oDisp = "A1:B5 => VAR = " & oResult & Chr$(10) & "VAR値"
	msgbox(oDisp,0,"ComputerFunction")
End Sub

CCFc-)[Calc]母集団に基づき、分散

Sub oUseCompute
	Dim oRange
	Dim oSheet
	Dim oResult as double
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:B5")
		oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.VARP )
		oDisp = "A1:B5 => VARP = " & oResult & Chr$(10) & "VARP値"
	msgbox(oDisp,0,"ComputerFunction")
End Sub

CCFc-)[Calc]Auditing Function


Sub oQUaryRange
	Dim oSheet
	Dim oCell
		oSheet = ThisComponent.Sheets(1)
		oCell = oSheet.getCellByposition(0,7)		'	A8 = Sum(A1:A7)
		oCellAd = oCell.CellAddress 
		oDisp1= oSheet.showPrecedents(oCellAd)
		oDisp2= oSheet.hidePrecedents(oCellAd)
		oDisp3= oSheet.showDependents(oCellAd)
		oDisp4= oSheet.hideDependents(oCellAd)
		oDisp5= oSheet.showErrors(oCellAd)
		oDisp6= oSheet.showInvalid()
		oDisp7= oSheet.clearArrows()
		oDisp = "[ A8 = SUM(A1:A7) ]" & Chr$(10) & Chr$(10)
		oDisp= oDisp & "oSheet.showPrecedents(oCell.Address) = " & oDisp1 & Chr$(10)
		oDisp= oDisp & "oSheet.hidePrecedents(oCell.Address) = " & oDisp2 & Chr$(10)
		oDisp= oDisp & "oSheet.showDependents(oCell.Address) = " & oDisp3 & Chr$(10)
		oDisp= oDisp & "oSheet.hideDependents(oCell.Address) = " & oDisp4 & Chr$(10)
		oDisp= oDisp & "oSheet.showErrors(oCell.Address) = " & oDisp5 & Chr$(10)
		oDisp= oDisp & "oSheet.showInvalid() = " & oDisp6 & Chr$(10)
		oDisp= oDisp & "oSheet.clearArrows() = " & oDisp7 & Chr$(10)
	MsgBox(oDisp,0,"com.sun.star.sheet.XSheetAuditing Intrface")
End Sub

CCFc-)[Calc]指定Cellの参照の表示


Sub CalcFunctionAuding()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oRowNo as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		'
		' 事前準備
		oRowNo = 6
		for i = 0 to oRowNo
			oCell = oSheet.getCellByPosition( 0, i )
			oCell.Value = i
		next i
		for i = 0 to oRowNo
			oCell = oSheet.getCellByPosition( 1, i )
			if i = 3 then
				oCell.Formula = "= A2"
			else
				oCell.Value = i
			end if
		next i
		oSheet.getCellByPosition( 0, oRowNo + 1 ).Formula = "=Sum(A1:A" & oRowNo + 1 & ")"
		'
		' 指定Cellの参照元を表示
		oCell = oSheet.getCellByPosition( 0, oRowNo + 1 )		' A7 の参照元から矢印。
		oSheet.showPrecedents(oCell.CellAddress)
		'
		msgbox "Success" & Chr$(10) & "( showPrecedents )"
End Sub

CCFc-)[Calc]指定Cellの参照の表示


Sub CalcFunctionAuding()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oRowNo as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		'
		' 事前準備
		oRowNo = 6
		for i = 0 to oRowNo
			oCell = oSheet.getCellByPosition( 0, i )
			oCell.Value = i
		next i
		for i = 0 to oRowNo
			oCell = oSheet.getCellByPosition( 1, i )
			if i = 3 then
				oCell.Formula = "= A2"
			else
				oCell.Value = i
			end if
		next i
		oSheet.getCellByPosition( 0, oRowNo + 1 ).Formula = "=Sum(A1:A" & oRowNo + 1 & ")"
		'
		' 指定Cellの参照先を表示
		oCell = oSheet.getCellByPosition( 0, 1 )		' A2 の参照先を矢印。共に参照されているCell も囲まれる。表示結果は showPrecedents と同じ
		oSheet.showDependents(oCell.CellAddress)
		'
		msgbox "Success" & Chr$(10) & "( showDependents )"
End Sub

CCFc-)[Calc]Formula Cellの参照元の表示削除(1a)


Sub CalcFunctionAuding()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oRowNo as Integer
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		'
		' 事前準備
		oRowNo = 6
		for i = 0 to oRowNo
			oCell = oSheet.getCellByPosition( 0, i )
			oCell.Value = i
		next i
		for i = 0 to oRowNo
			oCell = oSheet.getCellByPosition( 1, i )
			if i = 3 then
				oCell.Formula = "= A2"
			else
				oCell.Value = i
			end if
		next i
		oSheet.getCellByPosition( 0, oRowNo + 1 ).Formula = "=Sum(A1:A" & oRowNo + 1 & ")"
		'
		' 指定Cellの参照元を表示
		oCell = oSheet.getCellByPosition( 0, oRowNo + 1  )
		oSheet.showPrecedents(oCell.CellAddress)
		oDisp = "指定Cellの参照元を表示"
		msgbox(oDisp, 0, "showPrecedents")
		'
		' 参照先表示の削除
		if oSheet.hideDependents(oCell.CellAddress) then
			oDisp = "参照先表示を削除しました"
		else
			oDisp = "参照先表示は" & Chr$(10) & "設定されていません。"
		end if
		msgbox(oDisp, 0,"hideDependents")
		'
		if oSheet.hidePrecedents(oCell.CellAddress) then
			oDisp = "参照元を削除しました"
		else
			oDisp = "参照元表示は" & Chr$(10) & "設定されていません。"
		end if
		msgbox(oDisp, 0,"hideDependents")
End Sub

CCFc-)[Calc]指定CellのError元を参照(1)


Sub CalcFunctionAuding()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oRowNo as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		'
		' 事前準備
		oRowNo = 6
		for i = 0 to oRowNo
			oCell = oSheet.getCellByPosition( 0, i )
			if i = 1 then
				oCell.Formula = "= B4"
			else
				oCell.Value = i
			end if
		next i
		for i = 0 to oRowNo
			oCell = oSheet.getCellByPosition( 1, i )
			if i = 3 then
				oCell.Formula = "= A2"
			else
				oCell.Value = i
			end if
		next i
		oSheet.getCellByPosition( 0, oRowNo + 1 ).Formula = "=Sum(A1:A" & oRowNo + 1 & ")"
		'
		' 指定CellのError元Cellを表示
		oCell = oSheet.getCellByPosition( 0, oRowNo + 1 )		' A7 のError元から矢印。
		oSheet.showErrors(oCell.CellAddress)
		'
		msgbox "Success" & Chr$(10) & "( showErrors )"
End Sub

CCFc-)[Calc]指定CellのError元を参照(2)


Sub CalcFunctionAuding()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oRowNo as Integer
	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")
		'
		' 事前準備
		oRowNo = 6
		for i = 0 to oRowNo
			oCell = oSheet.getCellByPosition( 0, i )
			if i = 1 then
				oCell.Formula = "= B4"
			else
				oCell.Value = i
			end if
		next i
		for i = 0 to oRowNo
			oCell = oSheet.getCellByPosition( 1, i )
			if i = 3 then
				oCell.Formula = "= A2"
			else
				oCell.Value = i
			end if
		next i
		oSheet.getCellByPosition( 0, oRowNo + 1 ).Formula = "=Sum(A1:A" & oRowNo + 1 & ")"
		'
		' ErrorのCellに移動 & Trace
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "A8"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame,  ".uno:ShowErrors", "", 0, Array())
		'
		msgbox "Success" & Chr$(10) & "( uno:ShowErrors )"
End Sub

CCFc-)[Calc]Sheet中の全ての参照表示を削除


Sub CalcFunctionAuding()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oRowNo as Integer
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		'
		' 事前準備
		oRowNo = 6
		for i = 0 to oRowNo
			oCell = oSheet.getCellByPosition( 0, i )
			if i = 1 then
				oCell.Formula = "= B4"
			else
				oCell.Value = i
			end if
		next i
		for i = 0 to oRowNo
			oCell = oSheet.getCellByPosition( 1, i )
			if i = 3 then
				oCell.Formula = "= A2"
			else
				oCell.Value = i
			end if
		next i
		oSheet.getCellByPosition( 0, oRowNo + 1 ).Formula = "=Sum(A1:A" & oRowNo + 1 & ")"
		'
		' Sheetの参照Cellを表示
		oCell = oSheet.getCellByPosition( 0, oRowNo + 1 )		' A7 のError元から矢印。
		oSheet.showErrors(oCell.CellAddress)
		oDisp = "指定CellのErrorCellの" & Chr$(10) & "参照を表示しました。"
		msgbox(oDisp, 0, "showErrors")
		'
		' Sheet中の参照を全て削除
		oSheet.clearArrows()
		oDisp = "Sheet中の全ての参照表示を" & Chr$(10) & "削除しました。"
		msgbox(oDisp, 0, "clearArrows")
End Sub

CCFc-)[Calc]Trace → 自動更新ON/OFF

Sub UnoAuding()
	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 = "AutoRefreshArrows"
		oProp(0).Value = false					' ON : true / OFF : false
		oDispatcher.executeDispatch(oFrame,  ".uno:AutoRefreshArrows", "", 0, Array())
		msgbox "自動更新をOFFにしました。"
End Sub
'
' IDEからの実行では反映しない。
'






















CCFc-)[Calc]











[ Subtotal of Column ]

CCSbTL-)[Calc]列の小計


Sub CalcSubTotal
	Dim oDoc as Object, oSheet as Object, oRange as Object
	Dim oUnoObj01 as Object, oUnoObj02 as Object
	Dim oDesc as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		oRange = oSheet.getCellRangeByName("B1:E5")
		' Subtotal Condion of Column 1
		oUnoObj01 =  CreateUnoStruct("com.sun.star.sheet.SubTotalColumn")
		oUnoObj01.Column = 0 ' Column Index / relative Index = B Column
  		oUnoObj01.Function = com.sun.star.sheet.GeneralFunction.SUM
  		' Subtotal Condion of Column 2
		oUnoObj02 =  CreateUnoStruct("com.sun.star.sheet.SubTotalColumn")
		oUnoObj02.Column = 3 ' Column Index / relative Index = B Column
  		oUnoObj02.Function = com.sun.star.sheet.GeneralFunction.SUM
  		'
  		oDesc = oRange.createSubTotalDescriptor(True)
  		oDesc.addNew(Array(oUnoObj01, oUnoObj02), 1)  '   
  		oDesc.BindFormatsToContent = False
		'
  		oRange.applySubTotals(oDesc, True)
  		msgbox "Success"
End Sub
'
' [ Note ]
' 1) ' B列の横に結果を記す
'   oDesc.addNew(Array(oUnoObj01, oUnoObj02),1) 第二引数(=1)は結果を示すColumn No.( B列の結果を示す )

CCSbTL-)[Calc]列の小計(2)


Sub CalcSubTotal
	Dim oDoc as Object, oSheet as Object, oRange as Object
	Dim oUnoObj01 as Object, oUnoObj02 as Object
	Dim oDesc as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		oRange = oSheet.getCellRangeByName("B1:E5")
		' Subtotal Condion of Column 1
		oUnoObj01 =  CreateUnoStruct("com.sun.star.sheet.SubTotalColumn")
		oUnoObj01.Column = 0 ' Column Index / relative Index = B Column
  		oUnoObj01.Function = com.sun.star.sheet.GeneralFunction.SUM
  		' Subtotal Condion of Column 2
		oUnoObj02 =  CreateUnoStruct("com.sun.star.sheet.SubTotalColumn")
		oUnoObj02.Column = 3 ' Column Index / relative Index = B Column
  		oUnoObj02.Function = com.sun.star.sheet.GeneralFunction.SUM
  		'
  		oDesc = oRange.createSubTotalDescriptor(True)
  		oDesc.addNew(Array(oUnoObj01, oUnoObj02), 4)  '   
  		oDesc.BindFormatsToContent = False
		'
  		oRange.applySubTotals(oDesc, True)
  		msgbox "Success"
End Sub
' [Note ]
' oDesc.addNew(Array(oUnoObj01, oUnoObj02),4)
' 選択範囲の最終列(E列)に第二引数にすると表示が違う?

CCSbTL-)[Calc]Subtotal Dialog表示


Sub UnoSubTotal()
	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")
		' 範囲を指定した列のみ、Dialogに候補に表示される。
		oProp(0).Name = "ToPoint"
		oProp(0).Value = "B1:D5"	
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
		oDispatcher.executeDispatch(oFrame, ".uno:DataSubTotals", "", 0, Array())
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub


CCSbTL-)[Calc]列の小計の削除


Sub CalcSubTotal
	Dim oDoc as Object, oSheet as Object, oRange as Object
	Dim oUnoObj01 as Object, oUnoObj02 as Object
	Dim oDesc as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		oRange = oSheet.getCellRangeByName("B1:E5")
		' Subtotal Condion of Column 1
		oUnoObj01 =  CreateUnoStruct("com.sun.star.sheet.SubTotalColumn")
		oUnoObj01.Column = 0 ' Column Index / relative Index = B Column
  		oUnoObj01.Function = com.sun.star.sheet.GeneralFunction.SUM
  		' Subtotal Condion of Column 2
		oUnoObj02 =  CreateUnoStruct("com.sun.star.sheet.SubTotalColumn")
		oUnoObj02.Column = 3 ' Column Index / relative Index = B Column
  		oUnoObj02.Function = com.sun.star.sheet.GeneralFunction.SUM
  		'
  		oDesc = oRange.createSubTotalDescriptor(True)
  		oDesc.addNew(Array(oUnoObj01, oUnoObj02), 4)  '   
  		oDesc.BindFormatsToContent = False
		'
  		oRange.applySubTotals(oDesc, True)
  	' Remove subtotal
  	Dim oRange2 as Object
  		oRange2 = oSheet.getCellRangeByName("B1:E7")	' ← 小計表示部も範囲に含む事 / B1:E5 : NG
  		oRange2.removeSubTotals()
  		msgbox "Success",0,"LO4.4.2.2"
End Sub
' [ Note ]
' 1) PC能力にも依るが範囲が広いとApplicationのHange Upを生じる。( Example : "oSheet.removeSubTotals()" ) ⇒ I think "oSheet.removeSubTotals()" should be avoided.
' 2) 作成された列のOutlineは消えない。

CCSbTL-)[Calc]





[ 入力値規則 ]

CCVS-)[Calc]入力値を1~10に限定する


Sub SetValidationRange()
	Dim oRange as Object
	Dim oValidation as Object
	Dim oSheets as Object
		oSheets = ThisComponent.getSheets().getByName("sheet1")
		oRange = oSheets.getCellRangeByName("A1:D10")
		oValidation = oRange.Validation
			oValidation.Type = com.sun.star.sheet.ValidationType.DECIMAL
			oValidation.ErrorMessage = "Please enter a number between 1 to 10"
			ovalidation.ShowErrorMessage = true
			oValidation.ErrorAlertStyle = com.sun.star.sheet.ValidationAlertStyle.STOP
			oValidation.setOperator(com.sun.star.sheet.ConditionOperator.BETWEEN)
			'
			oValidation.setFormula1(1.0)
			oValidation.setFormula1(10,0)
			'
		oRange.Validation = oValidation
		msgbox "Success"
End Sub
'
'com.sun.star.sheet.TableValidation Service
'	Type				:	Validation Type	
'	ShowInputMessage	:	True => Input Message表示
'	InputTitle			:	Input MessageのTitel指定
'	InputMessage		:	Input Messageの表示文
'	ShowErrorMessage	:	true => Error Message表示
'	ErrorTitle			:	Error MessageのTitel指定
'	ErrorMessage		:	Eroor Messageの表示文
'	IgnoreBlankCells	:	true => Blank OKとする。
'	ErrorAlertStyle		:	Error Message後の処理方法



’Type
'com.sun.star.sheet.ValidationType enum( LibreOffice / ApacheOpenOffice )
'	com.sun.star.sheet.ValidationTYPE.ANY		:	全て拒否
'	com.sun.star.sheet.ValidationTYPE.WHOLE		:	整数のみOK
'	com.sun.star.sheet.ValidationTYPE.DECIMAL	:	特定の値のみOK
'	com.sun.star.sheet.ValidationTYPE.DATE		:	日付のみOK
'	com.sun.star.sheet.ValidationTYPE.TIME		:	時間のみOK
'	com.sun.star.sheet.ValidationTYPE.TEXT_LEN	:	既定長さ内の文字列OK
'	com.sun.star.sheet.ValidationTYPE.LIST		:	文字列LIST
'	com.sun.star.sheet.ValidationTYPE.CUSTOM	:	Custom
'
'com.sun.star.sheet.ValidationAlertStyle enum
'	com.sun.star.sheet.ValidationTYPE.STOP		:	Error Messege後入力値消去。	
'	com.sun.star.sheet.ValidationTYPE.WARNING	:	Warning Message。 このまま使用可能。
'	com.sun.star.sheet.ValidationTYPE.INFO		:	Information Message。このまま使用可能。
'	com.sun.star.sheet.ValidationTYPE.MACRO		:	指定MACRO実行

CCVS-)[Calc]文字列及び0以上の値以外は90°回転表示

Sub oSetConditionalStyle
	Dim oSheets
	Dim oRange
	Dim oConFormat
	Dim oCondition(2) as new com.sun.star.beans.PropertyValue
		oSheets = ThisComponent.Sheets(3)
		oRange = oSheets.getCellRangeByName("A1:D10")
	'Obtain the Validation object
		oConFormat = oRange.ConditionalFormat
			oCondition(0).Name = "Operator"
			oCondition(0).Value = com.sun.star.sheet.ConditionOperator.LESS
			oCondition(1).Name = "Formula1"
			oCondition(1).Value = 0
			oCondition(2).Name = "StyleName"
			oCondition(2).Value = "Heading1"
		oConFormat.addNew(oCondition())
		oRange.ConditionalFormat = oConFormat
End Sub
'
'com.sun.star.sheet.ConditionOperator enum
'	com.sun.star.sheet.ConditionOperator.NOME				:	全てOK
'	com.sun.star.sheet.ConditionOperator.EQUAL				:	指定値と同じ
'	com.sun.star.sheet.ConditionOperator.NOT_EQUAL			:	指定値以外
'	com.sun.star.sheet.ConditionOperator.GENERATER			:	指定値より大きい
'	com.sun.star.sheet.ConditionOperator.GENERATER_EQUAL	:	指定値以上
'	com.sun.star.sheet.ConditionOperator.LESS				:	指定値より小さい
'	com.sun.star.sheet.ConditionOperator.LESS_EQUAL			:	指定値以下
'	com.sun.star.sheet.ConditionOperator.BETWEEN			:	指定値間
'	com.sun.star.sheet.ConditionOperator.NOT_BETWEEN		:	指定値間以外
'	com.sun.star.sheet.ConditionOperator.FORMULA			:	結果が0にならない式

CCVS-)[Calc]条件付き書式Dialog表示(1)[ 条件 ]

Sub CalcConditionFormat()
	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:ConditionalFormatDialog", "", 0, Array())
End Sub

CCVS-)[Calc]条件付き書式Dialog表示(2)[ ColorScale ]

Sub CalcConditionFormat()
	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:ColorScaleFormatDialog", "", 0, Array())
End Sub
'
' [ Note ]
' Style名で設定する以外の設定方法については、APIが未対応の模様( LibreOffice4.0.1 )
' ColorScale / Databar / ManagerについてはDialog表示まで。
' 既に ColorScaleのFormatが設定済みの時は 条件 と同じDialogが表示

CCVS-)[Calc]条件付き書式Dialog表示(3)[ DataBar ]

Sub CalcConditionFormat()
	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:DataBarFormatDialog", "", 0, Array())
End Sub

CCVS-)[Calc]条件付き書式Dialog表示(4)[ 管理 ]

Sub CalcConditionFormat()
	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:ConditionalFormatManagerDialog", "", 0, Array())
End Sub

CCVS-)[Calc]List入力設定(1)


Sub CalcSetValidationRange()
	Dim oDoc as Object, oSheet as Object
	Dim oValidation as Object
		oDoc = ThisComponent
		oSheet = oDoc.Sheets().getByName("sheet1")
		oCell = oSheet.getCellRangeByName("A1")
		oValidation = oCell.Validation
		'
		oValidation.Type = com.sun.star.sheet.ValidationType.LIST
		'
		oValidation.Formula1 = """New York"";""London"";""Paris"";""Tokyo"""
		oCell.Validation = oValidation
		'
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		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:Validation", "", 0, Array())
		'
		msgbox "Success"
End Sub
'
' [ Note ]
'  oValidation.Formula1 = Array("NewYork","London","Paris","Tokyo") はError → Only String
'  区切り文字: Listの改行⇒「 ; 」
'  oValidation.Formula1 = """New York"";London;Paris;Tokyo"  →  "" で囲わないと、全て小文字になる。
'  半角Spaceを区切り文字にすると、1つのDataになる場合があるので避けた方がBetter。

CCVS-)[Calc]List入力設定(2)


Sub CalcSetValidationRange()
	Dim oDoc as Object, oSheet as Object
	Dim oValidation as Object
		oDoc = ThisComponent
		oSheet = oDoc.Sheets().getByName("sheet1")
		oCell = oSheet.getCellRangeByName("A1")
		oValidation = oCell.Validation
		'
		oValidation.Type = com.sun.star.sheet.ValidationType.LIST
		'
		oValidation.Formula1 = """New York"";London;Paris;Tokyo"
		oCell.Validation = oValidation
		'
		' Confirm
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		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:Validation", "", 0, Array())
		'
		msgbox "Success"
End Sub
'
' [ Note ]
'  oValidation.Formula1 = """New York"";London;Paris;Tokyo"  →  「許可する」の項目が「List」でなく、「Cell range」である事に注意。

CCVS-)[Calc]List入力設定(3)

Sub CalcSetValidationRange()
	Dim oDoc as Object, oSheet as Object
	Dim oValidation as Object
		oDoc = ThisComponent
		oSheet = oDoc.Sheets().getByName("sheet1")
		oCell = oSheet.getCellRangeByName("A1")
		oValidation = oCell.Validation
		'
		oValidation.Type = com.sun.star.sheet.ValidationType.LIST
		'
		oValidation.Formula1 = "$Sheet1.$C$1:$C$4"
		oCell.Validation = oValidation
		'
		' Confirm
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		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:Validation", "", 0, Array())
		'
		msgbox "Success"
End Sub



CCVS-)[Calc]List表示の非表示

Sub CalcSetValidationRange()
	Dim oDoc as Object, oSheet as Object
	Dim oValidation as Object
		oDoc = ThisComponent
		oSheet = oDoc.Sheets().getByName("sheet1")
		oCell = oSheet.getCellRangeByName("A1")
		oValidation = oCell.Validation
		'
		oValidation.Type = com.sun.star.sheet.ValidationType.LIST
		'
		oValidation.Formula1 = """New York"";""London"";""Paris"";""Tokyo"""
		oValidation.ShowList  = 0		' not show List
		oCell.Validation = oValidation
		'
	Dim oProp(0) as new com.sun.star.beans.PropertyValue
		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:Validation", "", 0, Array())
		'
		' Show List
		oValidation.ShowList  = 1
		oCell.Validation = oValidation
		oDispatcher.executeDispatch(oFrame,  ".uno:Validation", "", 0, Array())
		'
		msgbox "Success"
End Sub



CCVS-)[Calc]入力規則Dialog表示


Sub CalcValidation()
    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:Validation", "", 0, Array())
		'
		msgbox "Success"
End Sub

CCVS-)[Calc]











[ 連続Data / Fill ]

CCCd-)[Calc]右方向に連続Data作成

Sub oFill
	Dim oRange
	Dim oSheet
	Dim oAllData
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:G1")
		oSheet.getCellByPosition(0,0).Value=1
		oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_RIGHT, 1)	' 	2 => 1cell飛ばしで入力 1=>連続
	'Get Data
		oAllData = oRange.getDataArray()
		for i = 0 to UBound(oAllData)
			oDisp = join(oAllData(i), " : ")
		next i
	msgbox(oDisp,0,"連続Data")
	oRange.clearContents(com.sun.star.sheet.CellFlags.VALUE)
End Sub

CCCd-)[Calc]左方向に連続Data作成

Sub oFill
	Dim oRange
	Dim oSheet
	Dim oAllData
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:G1")
		oSheet.getCellByPosition(6,0).Value=1
		oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_LEFT, 2)	' 	2 => 1cell飛ばしで入力 1=>連続
	'Get Data
		oAllData = oRange.getDataArray()
		for i = 0 to UBound(oAllData)
			oDisp = join(oAllData(i), " : ")
		next i
	msgbox(oDisp,0,"連続Data")
	oRange.clearContents(com.sun.star.sheet.CellFlags.VALUE)
End Sub

CCCd-)[Calc]上方向に連続Data作成

Sub oFill
	Dim oRange
	Dim oSheet
	Dim oAllData
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:A10")
		oSheet.getCellByPosition(0,9).Value=1
		oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_TOP, 1 )	' 	2 => 1cell飛ばしで入力 1=>連続
	'Get Data
		oAllData = oRange.getDataArray()
		for i = 0 to UBound(oAllData)
			oDisp = oDisp & join(oAllData(i) ) & Chr$(10)
		next i
	msgbox(oDisp,0,"連続Data")
	oRange.clearContents(com.sun.star.sheet.CellFlags.VALUE)
End Sub

CCCd-)[Calc]下方向に連続Data作成1


Sub SetFillData()
	Dim oDoc as Object, oSheet as Object
	Dim oRange as Object
	Dim oAllData() as Variant
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oRange = oSheet.getCellRangeByName("A1:C10")
		oSheet.getCellByPosition(0,0).Value = 1	' 値
		' 日付、時刻 / Serial値で無いと月や分が変わらない / Cell Formatは事前に設定
		oSheet.getCellByPosition(1,0).Value = DateSerial(2012,12,29)	
		oSheet.getCellByPosition(2,0).Value = TimeSerial(12,24,56)
		oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, 2 )
	'Get Data 
		oAllData = oRange.getDataArray()
		for i = 0 to UBound(oAllData)
			oDisp = oDisp & join(oAllData(i)," → ") & Chr$(10)
		next i
	msgbox(oDisp,0,"連続Data")
	'
	' DataのClear
	Dim oFlag as Long
		' VALUE, DATETIMEの削除
		oFlag = com.sun.star.sheet.CellFlags.VALUE + com.sun.star.sheet.CellFlags.DATETIME
	oRange.clearContents(oFlag)
End Sub
'
' [ Note ]
' .fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, 2 )	' 	2 → Cell Addressの増分値

CCCd-)[Calc]下方向に連続Data作成2-1(足し算)


Sub SetFillData()
	Dim oDoc as Object, oSheet as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp1(0) as new com.sun.star.beans.PropertyValue
	Dim oProp(5) as new com.sun.star.beans.PropertyValue
	Dim oStep as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Cell Formatは事前に設定
		oSheet.getCellByPosition(0,0).Value = 1
		oSheet.getCellByPosition(1,0).Value = DateSerial(2012,12,29)
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
			oProp1(0).Name = "ToPoint"
			oProp1(0).Value = "$A$1:$B$10"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
			'
			oProp(0).Name = "FillDir"
			oProp(0).Value = "B"
			oProp(1).Name = "FillCmd"
			oProp(1).Value = "L"
			oProp(2).Name = "FillStep"
			oProp(2).Value = "2"
			oProp(3).Name = "FillDateCmd"
			oProp(3).Value = "D"
			oProp(4).Name = "FillStart"
			oProp(4).Value = ""
			oProp(5).Name = "FillMax"
			oProp(5).Value = "1.70000000E+307"
		oDispatcher.executeDispatch(oFrame, ".uno:FillSeries", "", 0, oProp())
		'
	msgbox "Success"
End Sub
'
' [  Note ]
'  0) FillDir : 方向
'   B : 上から下へ / T : 下から上へ / R : 左から右へ / L : 右から左へ 
'  1) FillCmd : 連続Dataの種類 
'   L : 足し算 / G : 掛け算 / D : 日付 / A : AutoFill 
'   日付Dataが含まれている時は G : 掛け算 不可 
'  2) FillStep : 増分
'  3) FillDateCmd : 日付の単位
'   Y : Year / M : Month / D : Day / W : WeekDay( FillCmd が D or L の時のみ利用可能 )
'  4) FillStart : 開始値
'   複数の列の連続Dataを作成する際、macro の 記録では "1.70000000E+307"となるが、空白に修正しないと左端の列は "1.70000000E+307"に置き換わってしまう
'  5) FillMax : 停止値
'   "1.70000000E+307"は設定無しと同じ

CCCd-)[Calc]下方向に連続Data作成2-2(掛け算)


Sub SetFillData()
	Dim oDoc as Object, oSheet as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp1(0) as new com.sun.star.beans.PropertyValue
	Dim oProp(5) as new com.sun.star.beans.PropertyValue
	Dim oStep as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Cell Formatは事前に設定
		oSheet.getCellByPosition(0,0).Value = 1
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
			oProp1(0).Name = "ToPoint"
			oProp1(0).Value = "$A$1:$A$10"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
			'
			oProp(0).Name = "FillDir"
			oProp(0).Value = "B"
			oProp(1).Name = "FillCmd"
			oProp(1).Value = "G"
			oProp(2).Name = "FillStep"
			oProp(2).Value = "5"
			oProp(3).Name = "FillDateCmd"
			oProp(3).Value = ""
			oProp(4).Name = "FillStart"
			oProp(4).Value = ""
			oProp(5).Name = "FillMax"
			oProp(5).Value = "1.70000000E+307"
		oDispatcher.executeDispatch(oFrame, ".uno:FillSeries", "", 0, oProp())
		'
	msgbox "Success"
End Sub

CCCd-)[Calc]下方向に連続Data作成2-3(Weekday)


Sub SetFillData()
	Dim oDoc as Object, oSheet as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp1(0) as new com.sun.star.beans.PropertyValue
	Dim oProp(5) as new com.sun.star.beans.PropertyValue
	Dim oStep as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Cell Formatは事前に設定
		oSheet.getCellByPosition(1,0).Value = DateSerial(2012,12,28)
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
			oProp1(0).Name = "ToPoint"
			oProp1(0).Value = "$B$1:$B$10"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
			'
			oProp(0).Name = "FillDir"
			oProp(0).Value = "B"
			oProp(1).Name = "FillCmd"
			oProp(1).Value = "D"			' ← D or L のみ
			oProp(2).Name = "FillStep"
			oProp(2).Value = "4"
			oProp(3).Name = "FillDateCmd"
			oProp(3).Value = "W"
			oProp(4).Name = "FillStart"
			oProp(4).Value = ""
			oProp(5).Name = "FillMax"
			oProp(5).Value = "1.70000000E+307"
		oDispatcher.executeDispatch(oFrame, ".uno:FillSeries", "", 0, oProp())
		'
	msgbox "Success"
End Sub

CCCd-)[Calc]下方向に連続Data作成2-4(AutoFill)


Sub SetFillData()
	Dim oDoc as Object, oSheet as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp1(0) as new com.sun.star.beans.PropertyValue
	Dim oProp(5) as new com.sun.star.beans.PropertyValue
	Dim oStep as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Cell Formatは事前に設定
		oSheet.getCellByPosition(0,0).String = "1月"
		oSheet.getCellByPosition(0,1).String = "3月"
		oSheet.getCellByPosition(1,0).String = "10年"
		oSheet.getCellByPosition(1,1).String = "20年"
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
			oProp1(0).Name = "ToPoint"
			oProp1(0).Value = "$A$1:$B$6"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
			'
			oProp(0).Name = "FillDir"
			oProp(0).Value = "B"
			oProp(1).Name = "FillCmd"
			oProp(1).Value = "A"	
			oProp(2).Name = "FillStep"
			oProp(2).Value = ""			' ← AutoFill 時は 設定不可
			oProp(3).Name = "FillDateCmd"
			oProp(3).Value = ""
			oProp(4).Name = "FillStart"
			oProp(4).Value = ""
			oProp(5).Name = "FillMax"
			oProp(5).Value = "1.70000000E+307"
		oDispatcher.executeDispatch(oFrame, ".uno:FillSeries", "", 0, oProp())
		'
	msgbox "Success"
End Sub

CCCd-)[Calc]下方向に連続Data作成2-5(上限を付けて)


Sub SetFillData()
	Dim oDoc as Object, oSheet as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
	Dim oProp1(0) as new com.sun.star.beans.PropertyValue
	Dim oProp(5) as new com.sun.star.beans.PropertyValue
	Dim oStep as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Cell Formatは事前に設定
		oSheet.getCellByPosition(0,0).Value = 3
		oSheet.getCellByPosition(1,0).String = 5
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
			oProp1(0).Name = "ToPoint"
			oProp1(0).Value = "$A$1:$B$7"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
			'
			oProp(0).Name = "FillDir"
			oProp(0).Value = "B"
			oProp(1).Name = "FillCmd"
			oProp(1).Value = "G"	
			oProp(2).Name = "FillStep"
			oProp(2).Value = "2"			
			oProp(3).Name = "FillDateCmd"
			oProp(3).Value = ""
			oProp(4).Name = "FillStart"
			oProp(4).Value = ""
			oProp(5).Name = "FillMax"
			oProp(5).Value = "100"
		oDispatcher.executeDispatch(oFrame, ".uno:FillSeries", "", 0, oProp())
		'
	msgbox "Success"
End Sub

CCCd-)[Calc]Table Operation[ 複数演算 ](1)

Sub oMultipleOpsColumns()
	Dim oRange
	Dim oSheet
	Dim oCell
	Dim oBlockAddress
	Dim oCellAddress
		oSheet = ThisComponent.getSheets().getByIndex(0)
	'Set the topmost Value
		oCell = oSheet.getCellByPosition(0,9)
			oCell.setValue(0)
		'Fill the Values Down! for 0 to about 6.4
		oRange = oSheet.getCellRangeByName("A10:A73")
		oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, _
								com.sun.star.sheet.FillMode.LINEAR, _
								com.sun.star.sheet.FillDateMode.FILL_DATE_DAY, 0.1, 6.4)
	'Setting the Sin() and Cos() Header Values
		oCell = oSheet.getCellByPosition(1,8)
			oCell.setString("Sin()")
		oCell = oSheet.getCellByPosition(2,8)
			oCell.setString("Cos()")
	'Setting the Sin() and Cos() Formulas
		oCell = oSheet.getCellByPosition(1,9)
			oCell.setFormula("Sin(A10)")
		oCell = oSheet.getCellByPosition(2,9)
			oCell.setFormula("Cos(A10)")
	'Set Range
		oRange = oSheet.getCellRangeByName("A11:C73")
	'Get Address to copy
		oBlockAddress = oSheet.getCellRangeByName("B10:C10").getRangeAddress()
	'Column Address
		oCellAddress = oSheet.getCellByPosition(0,9).getCellAddress()
	'
		oRange.setTableOperation(oBlockAddress, _
		com.sun.star.sheet.TableOperationMode.COLUMN , oCellAddress, oCellAddress)
		'
End Sub
'
' [ com.sun.star.sheet.FillDateMode enum( LibreOffice / Apache OpenOffice ]
' com.sun.star.sheet.FillDateMode.FILL_DATE_DAY
' com.sun.star.sheet.FillDateMode.FILL_DATE_WEEKDAY
' com.sun.star.sheet.FillDateMode.FILL_DATE_MONTH
' com.sun.star.sheet.FillDateMode.FILL_DATE_YEAR
'
'
' 複数演算( Table Operation )の使用方法はLibreOffice HelpNPO法人オーユージー/ 出版物リストの0610_データテーブル(複数演算)を参照 
' [ com.sun.star.sheet.TableOperationMode Enum( LibreOffice / Apache OpenOffice ]

CCCd-)[Calc]Table Operation[ 複数演算 ](2)


Sub MultipleOpsColumns()
	Dim oRange as Object
	Dim oSheet as Object
	Dim oCell as Object
	Dim oCellAddress as Object
		oSheet = ThisComponent.getSheets().getByIndex(0)
	'Set the Row Values of constant values 
		oRowCell = oSheet.getCellRangeByName("B1")
			oRowCell.setValue(1)
		oRange = oSheet.getCellRangeByName("B1:K1")
			oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_RIGHT,  1)
	'Set the Column Values of constant values
		oColCell = oSheet.getCellRangeByName("A2")
			oColCell.setValue(1)
		oRange = oSheet.getCellRangeByName("A2:A10")
			oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM,  1)
	'Set the first formula and Value
		oCell = oSheet.getCellRangeByName("A1")
			oCell.setFormula("=A2*B1")
	'Get Range of the Cells
		oRange = oSheet.getCellRangeByName("A1:K10")
	'Fill the multiplication tables for the value 1*1 through 10*10
		oRange.setTableOperation(oRange.getRangeAddress(), _
									com.sun.star.sheet.TableOperationMode.BOTH, _
								oColCell.getCellAddress(), _
								oRowCell.getCellAddress())
		msgbox "Success",0,"LO4.3.1"
End Sub

CCCd-)[Calc]複数演算Dialog表示


Sub UnoTableOperation()
	Dim oDoc as Object, oSheet as Object, oCell as Object 
	Dim oRange as Object, oSel as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		for i = 0 to 2
			oCell = oSheet.getCellByPosition( 0, i )
			oCell.Value = i + 1
		next i
		' 範囲の選択( 必須 )
		oRange = oSheet.getCellRangeByName("A1:A3")
		oDoc.getCurrentController().select(oRange) 
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' 複数演算Dialog表示
		oDispatcher.executeDispatch(oFrame,  ".uno:TableOperationDialog", "", 0, Array())
		msgbox("表示",0,"複数演算")
End Sub

CCCd-)[Calc]右方向に同じ値を入力


Sub SetFillData()
	Dim oDoc as Object, oSheet as Object
	Dim 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
	Dim oStep as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Cell Formatは事前に設定
		oSheet.getCellByPosition(0,0).Value = 1
		oSheet.getCellByPosition(0,1).Value = DateSerial(2012,1,1)
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
			oProp1(0).Name = "ToPoint"
			oProp1(0).Value = "$A$1:$D$2"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
		oDispatcher.executeDispatch(oFrame, ".uno:FillRight", "", 0, oProp())
		'
	msgbox "Success"
End Sub

CCCd-)[Calc]左方向に同じ値を入力


Sub SetFillData()
	Dim oDoc as Object, oSheet as Object
	Dim 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
	Dim oStep as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Cell Formatは事前に設定
		oSheet.getCellByPosition(3,0).String = "Left"
		oSheet.getCellByPosition(3,1).Value = DateSerial(2012,2,3)
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
			oProp1(0).Name = "ToPoint"
			oProp1(0).Value = "$A$1:$D$2"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
		oDispatcher.executeDispatch(oFrame, ".uno:FillLeft", "", 0, oProp())
		'
	msgbox "Success"
End Sub

CCCd-)[Calc]上方向に同じ値を入力


Sub SetFillData()
	Dim oDoc as Object, oSheet as Object
	Dim 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
	Dim oStep as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Cell Formatは事前に設定
		oSheet.getCellByPosition(0,4).String = "Up"
		oSheet.getCellByPosition(1,4).Value = DateSerial(2012,3,1)
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
			oProp1(0).Name = "ToPoint"
			oProp1(0).Value = "$A$1:$B$5"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
		oDispatcher.executeDispatch(oFrame, ".uno:FillUp", "", 0, oProp())
		'
	msgbox "Success"
End Sub

CCCd-)[Calc]下方向に同じ値を入力


Sub SetFillData()
	Dim oDoc as Object, oSheet as Object
	Dim 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
	Dim oStep as Integer
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		' Cell Formatは事前に設定
		oSheet.getCellByPosition(0,0).String = "Down"
		oSheet.getCellByPosition(1,0).Value = DateSerial(2012,4,3)
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
			'
			oProp1(0).Name = "ToPoint"
			oProp1(0).Value = "$A$1:$B$5"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
		oDispatcher.executeDispatch(oFrame, ".uno:FillDown", "", 0, oProp())
		'
	msgbox "Success"
End Sub

CCCd-)[Calc]「テキストから列へ」Dialog表示

Sub UnoTableToCol()
	Dim oDoc as Object, oSheet as Object, oCell as Object 
	Dim oRange as Object, oSel as Object
	Dim oCtrl as Object, oFrame as Object
	Dim oDispatcher as Object
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByName("sheet1")
		oCell = oSheet.getCellByPosition( 0, 0 )
		oCell.String = "LiberOffice" & Chr$(9) & "Apache OpenOffice"
		' 範囲の選択( 必須 )
		oRange = oSheet.getCellRangeByName("A1")
		oDoc.getCurrentController().select(oRange) 
		'
		oCtrl = oDoc.getCurrentController()
		oFrame = oCtrl.getFrame()
		oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
		'
		' 「 テキストから列へ 」Dialog表示
		oDispatcher.executeDispatch(oFrame,  ".uno:TextToColumns", "", 0, Array())
		msgbox("Success",0,"テキストから列へ")
End Sub
'
' [ Note ]
' 「テキストから列へ」の使い方は無料のオープンオフィス エクセルのフリーソフト OpenOffice リブレオフィスをExcelと同じように使うブログ EOL / 区切り位置でデータを分割したい を参照




[ Recalcuation( 再計算 ) ]

CCRC-)[Calc]再計算[ Key F9 ](1)


Sub oCalcReCalculation()
	Dim oDoc as Object
		oDoc = ThisComponent
	' ReCalculation
		oDoc.calculateAll()
		'
	msgbox "Success"
End Sub
'
' [ 注意事項 ]
1) Default では図の 「ツール」→「セルの内容」→「自動計算」にCheckが入っているので、
Macroの効果を確認する為には事前にCheckを外しておく。

CCRC-)[Calc]再計算[ Key F9 ](2)

Sub oCalcReCalculation()
	Dim oDoc as Object
		oDoc = ThisComponent
	' ReCalculation
	Dim oFrame as Object
	Dim oDispacher as Object
		oFrame   = oDoc.CurrentController.Frame
		oDispacher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispacher.executeDispatch(oFrame, ".uno:Calculate", "", 0, Array())
		oDoc.calculateAll()
		'
	msgbox "Success"
End Sub

CCRC-)[Calc]無条件の再計算[ Key Ctrl+Shift+F9 ](1)

Sub CalcReCalculation()
	Dim oDoc as Object
		oDoc = ThisComponent
	' ReCalculation
		oDoc.calculate()
		'
	msgbox "Success"
End Sub

CCRC-)[Calc]無条件の再計算[ Key Ctrl+Shift+F9 ](2)

Sub oCalcReCalculation()
	Dim oDoc as Object
		oDoc = ThisComponent
	' ReCalculation
	Dim oFrame as Object
	Dim oDispacher as Object
		oFrame   = oDoc.CurrentController.Frame
		oDispacher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispacher.executeDispatch(oFrame, ".uno:CalculateHard", "", 0, Array())
		'
	msgbox "Success"
End Sub

CCRC-)[Calc]自動計算のToggleのON / OFF設定


Sub oCalcReCalculation()
	Dim oDoc as Object
		oDoc = ThisComponent
	' ReCalculation
	Dim oFrame as Object
	Dim oDispacher as Object
		oFrame   = oDoc.CurrentController.Frame
		oDispacher = createUnoService("com.sun.star.frame.DispatchHelper")
		oDispacher.executeDispatch(oFrame, ".uno:AutomaticCalculation", "", 0, Array())
		'
	oDisp = "自動計算の設定を変更しました。" & Chr$(10) & _
				" ON → OFF  又は  OFF → ON"
	msgbox oDisp,0,"自動計算の設定"
End Sub

CCRC-)[Calc]自動計算のToggleのON / OFF設定と確認



Sub CalcCalculation()
	Dim oDoc as Object
	Dim oChkCalc as Boolean
	Dim oDisp as String
		oDoc = ThisComponent
		' Check Automatic Calculation( Before )
		oChkCalc = oDoc.IsAutomaticCalculationEnabled()
		'
		oDisp = "[ 自動計算ON/OFF ]" & Chr$(10) & "Before : " & oChkCalc
		'
		' Change Setting of Automatic Calculation
		oDoc.enableautomaticCalculation( false )	' true : ON / false : OFF
		msgbox "自動計算をOFFにしました。"
		'
		oChkCalc = oDoc.IsAutomaticCalculationEnabled()
		oDisp = oDisp & Chr$(10) & "After : " & oChkCalc
		'
		msgbox oDisp,0,"自動計算"
End Sub


[ AutoInput(オートインプット) ]

CCRC-)[Calc]AutoImputのON/OFF

Sub UnoAutoInput()
   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")
		'
		' ツール ⇒ セルの内容 ⇒ オートインプット ON / 既にONになっている場合は OFFになる
		oDispatcher.executeDispatch(oFrame, ".uno:AutoComplete", "", 0, Array())
		oProp(0).Name = "ToPoint"
			oProp(0).Value = "A1"
		oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
			oProp(0).Name = "StringName"
			oProp(0).Value = "LibreOffice4.2.2"
		oDispatcher.executeDispatch(oFrame, ".uno:EnterString", "", 0, oProp())
		msgbox "オートインプットON",0,"AutoImput"
End Sub




[ Consolidate(統合) ]

CCCslt-)[Calc]Dataの統合


Sub MacroConslidate()
	Dim oDoc as Object
	Dim oDesc as Object
	Dim oRange1 as Object, oRange2 as Object, oOutRng as Object
		oDoc = ThisComponent
  		oDesc = oDoc.createConsolidationDescriptor(False)
  		' Sorce範囲設定
  		oRange1 = CreateUnoStruct("com.sun.star.table.CellRangeAddress")
  		With oRange1
    		.Sheet = 0 
    		.StartColumn = 0
    		.EndColumn = 1
    		.StartRow = 0
    		.EndRow = 2
  		End With
  		oRange2 = CreateUnoStruct("com.sun.star.table.CellRangeAddress")
  		With oRange2
    		.Sheet = 0 
    		.StartColumn = 3
    		.EndColumn = 3
    		.StartRow = 0
    		.EndRow = 2
  		End With
		oDesc.setSources(Array(oRange1, oRange2))
		'
		' 出力位置
		oOutRng = CreateUnoStruct("com.sun.star.table.CellAddress")
		With oOutRng
  			.Sheet = 0
  			.Column = 0
  			.Row = 5
		End With
		oDesc.setStartOutputPosition(oOutRng)
		' Link
		if oDesc.getInsertLinks = false then
			oDesc.setInsertLinks(true)		' 統合元DataとLinkする
		end if
		' Column Label
		oDesc.setUseColumnHeaders(false)
		' Row Label
		oDesc.setUseRowHeaders(false) 
		'
		' 統合を適用
		oDoc.consolidate(oDesc)
		msgbox "Success"
End Sub
'
' [ Note ]
' Dataの統合の使い方は北海道立教育研究所が公開しているPDF Fileを参照。

CCCslt-)[Calc]Dataの統合Dialog表示


Sub MacroConslidate()
	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:DataConsolidate", "", 0, Array())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub


[ Tokens ]

CCTkn-)[Calc]FormulaToken


Sub CalcTokens()
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCell as Object
	Dim oToken as Object
	Dim oDisp as String
	Dim oTokenStr as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oCell = oSheet.getCellByPosition(0,2)
		'
		oToken = oCell.getTokens()
		'
		oDisp = CStr(oCell.Formula) & Chr$(10) & Chr$(10)
		for i = 0 to UBound(oToken)
			select case oToken(i).OpCode
				case 0
					oTokenStr = "Cell Addess or 数値"
				case 8
					oTokenStr = "("
				case 9
					oTokenStr = ")"
				case 14
					oTokenStr = " "		' 半角Space
				case 40
					oTokenStr = "+"
				case 41
					oTokenStr = "-"
				case 42
					oTokenStr = "*"
				case 43
					oTokenStr = "/"
				case 65
					oTokenStr = "PI"
				case 82
					oTokenStr = "Sin"
				case 83
					oTokenStr = "Cos"
				case 84
					oTokenStr = "Tan"
				case 224
					oTokenStr = "Sum"
				case else
					oTokenStr = "未登録"
			end select
			oDisp = oDisp & " " & i + 1 & ") " & oTokenStr & Chr$(10)
		next i
		msgbox(oDisp,0,"Cell の Tokens")
End Sub

CCTkn-)[Calc]





[ Name Range ]

CCNmRg-)[Calc]Name Range有無確認/削除/設定


Sub CalcNameRange()
	Dim oDoc as Object, oSheet as Object
	Dim oRange as Object
	Dim oRngAbsName as String
	Dim oRngName as String
	Dim oDocNmRng as Object
	Dim oTbCellAdrr as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oRange = oSheet.getCellRangeByName("A2:D6")
		oRngAbsName = oRange.AbsoluteName
		'
		oRngName = "TestName"
		'
		' 同じRange Nameを付けようとするとCrashするので、同名Range Nameは一旦、削除する
		oDocNmRng = oDoc.NamedRanges
 		If oDocNmRng.hasByName(oRngName) Then
   			oDocNmRng.removeByName(oRngName)
 		End If
 		'
 		' Rangeの相対Origin設定
 		oTbCellAdrr = createUnoStruct("com.sun.star.table.CellAddress")
 		with oTbCellAdrr
 			.sheet = 0
 			.column = 0
 			.row = 0
 		end with
 		' Name Range設定
 		oDocNmRng.addNewByName(oRngName, oRngAbsName, oTbCellAdrr, 0 )
 		'
 		oDisp = "Name Range : " & oRngName & Chr$(10) & " Exist ? →  " & oDocNmRng.hasByName(oRngName)
 		msgbox oDisp,0,"Name Range"
End Sub
'
' [ Note ]
' com.sun.star.sheet.XNamedRanges( LibreOffice / Apache OpenOffice )
' Name Ranges( Apache OpenOffice )
' NamedRanges Service Reference( LibreOffice )
'
' constans com.sun.star.sheet.NamedRangeFlag( LibreOffice / Apache OpenOffice )
' 0 : Common name range
' 1 : com.sun.star.sheet.NamedRangeFlag.FILTER_CRITERIA
' 2 : com.sun.star.sheet.NamedRangeFlag.PRINT_AREA
' 4 : com.sun.star.sheet.NamedRangeFlag.COLUMN_HEADER
' 8 : com.sun.star.sheet.NamedRangeFlag.ROW_HEADER

CCNmRg-)[Calc]Title RowからName Range設定


Sub CalcNameRange()
	Dim oDoc as Object
	Dim oDocNmRng as Object
	Dim oEnum as Object
	Dim oElmt as Object
	Dim oTbRngCellAdrr as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oDocNmRng = oDoc.NamedRanges
		'
		' 同じRange Nameを付けようとするとCrashするので、一旦、全てのRange Nameを削除する
		oEnum = oDocNmRng.createEnumeration()
		nn = 0
		Do while oEnum.hasMoreElements()
			oElmt = oEnum.nextElement()
			oDocNmRng.removeByName(oElmt.Name)
			nn = nn + 1
			if nn > 1000 then
				Exit Do
			End if
		Loop
		'
 		' Range設定
 		oTbRngCellAdrr = createUnoStruct("com.sun.star.table.CellRangeAddress")
 		with oTbRngCellAdrr
 			.sheet = 0
 			.StartColumn = 0
 			.EndColumn = 2
 			.StartRow = 0
 			.EndRow = 4
 		end with
 		' Name Range設定 / Title行取得
 		oDocNmRng.addNewFromTitles(oTbRngCellAdrr, com.sun.star.sheet.Border.TOP )
 		'
 		oDisp = "[ Name Range ]"
 		oEnum = oDocNmRng.createEnumeration()
		nn = 0
		Do while oEnum.hasMoreElements()
			oElmt = oEnum.nextElement()
			oDisp = oDisp & Chr$(10) & oElmt.Name
			nn = nn + 1
			if nn > 1000 then
				Exit Do
			End if
		Loop
 		msgbox oDisp,0,"Name Range"
End Sub

CCNmRg-)[Calc]Name Range出力


Sub CalcNameRange()
	Dim oDoc as Object
	Dim oDocNmRng as Object
	Dim oEnum as Object
	Dim oElmt as Object
	Dim oTbRngCellAdrr as Object
	Dim oTbCellAddr as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oDocNmRng = oDoc.NamedRanges
		'
		oEnum = oDocNmRng.createEnumeration()
		nn = 0
		Do while oEnum.hasMoreElements()
			oElmt = oEnum.nextElement()
			oDocNmRng.removeByName(oElmt.Name)
			nn = nn + 1
			if nn > 1000 then
				Exit Do
			End if
		Loop
		'
 		' Range設定
 		oTbRngCellAdrr = createUnoStruct("com.sun.star.table.CellRangeAddress")
 		with oTbRngCellAdrr
 			.sheet = 0
 			.StartColumn = 0
 			.EndColumn = 2
 			.StartRow = 0
 			.EndRow = 4
 		end with
 		' Name Range設定 / Title行取得
 		oDocNmRng.addNewFromTitles(oTbRngCellAdrr, com.sun.star.sheet.Border.TOP )
 		'
 		oTbCellAddr  = createUnoStruct("com.sun.star.table.CellAddress")
 		with oTbCellAddr
 			.sheet = 0
 			.Column = 0
 			.Row = 6
 		end with
 		'
 	' output先Cell のFormatを Text設定
 	Dim NumberFormats As Object
	Dim NumberFormatString As String
	Dim NumberFormatId As Long
	Dim LocalSettings As New com.sun.star.lang.Locale
 		oSheet = oDoc.getSheets().getByIndex(0)
 		oOutRng = oSheet.getCellRangeByname("A7:B9")
 		NumberFormats = oDoc.NumberFormats
		NumberFormatString = "@"
		NumberFormatId = NumberFormats.queryKey(NumberFormatString, LocalSettings, True)
 		'
		NumberFormatId = NumberFormats.queryKey(NumberFormatString, LocalSettings, True)
		If NumberFormatId = -1 Then
   			NumberFormatId = NumberFormats.addNew(NumberFormatString, LocalSettings)	'書式コードを追加
		End If
		oOutRng.NumberFormat = NumberFormatId
 		'
 		' Output Name Range
 		oDocNmRng.outputList(oTbCellAddr)
 		'
 		msgbox "Success",0,"Name Range"
End Sub

CCNmRg-)[Calc]名前の管理Dialog表示


Sub UnoNameRange()
	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:DefineName", "", 0, Array())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCNmRg-)[Calc]名前の挿入Dialog表示


Sub UnoNameRange()
	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:InsertName", "", 0, Array())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCNmRg-)[Calc]名前の作成Dialog表示


Sub UnoNameRange()
	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:CreateNames", "", 0, Array())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub

CCNmRg-)[Calc]名前のラベルDialog表示


Sub UnoNameRange()
	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:DefineLabelRange", "", 0, Array())
		'
	msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub


CCNmRg-)[Calc]





Query

CCQ-)[Calc]空白以外のCell Address抽出1

Sub oNonEmptyCellsinRange
	Dim oSheet
	Dim oRange
	Dim oCell
	Dim orangeQuery
	Dim oAddress()
	Dim oAd
	Dim i as Long
	Dim nRow as Long
	Dim nCol as Long
		oSheets = ThisComponent.Sheets(1)
		oRange = oSheets.getCellRangeByName("A1:G20")
		oRangeQuery =oRange.queryContentCells(com.sun.star.sheet.CellFlags.VALUE OR _
												com.sun.star.sheet.CellFlags.DATETIME OR _
												com.sun.star.sheet.CellFlags.STRING OR _
												com.sun.star.sheet.CellFlags.FORMULA)
		oAddress() = oRangeQuery.getRangeAddresses()
		for i = 0 to UBound(oAddress())
			oAd = oAddress(i)
			for nRow = oAddress(i).StartRow to oAddress(i).EndRow
				for nCol = oAddress(i).StartColumn to oAddress(i).EndColumn
					oCell = oRange.Spreadsheet.getCellByPosition(nCol,nRow)
					oDisp = oDisp & PrintableAddressOfCell(oCell) & Chr$(10)
				next nCol
			next nRow
		next i
	msgbox(oDisp,0,"")
End Sub

'[ Function1 ]
Function PrintableAddressOfCell(oCell) as String
	If IsNull(oCell) OR IsEmpty(oCell) then
		PrintableAddressOfCell = "Unknown"
	else
		PrintableAddressOfCell =oCell.getSpreadSheet().getName & " : " & _
			ColumnNumberToString(oCell.CellAddress.Column) & _
			CStr(oCell.CellAddress.Row+1)
	End If
End Function
'
'[ 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

CCQ-)[Calc]空白以外のCell Address抽出2

Sub oTraverseRows
	Dim oSheet
	Dim oRange
	Dim oRangeRow
	Dim oRow
	Dim oRowEnum
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:G20")
			oRangeRow = oRange.getRows()
			oRowEnum = oRangeRow.createEnumeration()
			Do While oRowEnum.hasMoreElements()
				oRow = oRowEnum.nextElement()
				oDisp = oDisp & oNonEmptyCellsInRange(oRow,"  ") & Chr$(10)
			Loop
		Msgbox(oDisp,0,"Non-Empty Cell In Row")
End Sub

'[ Function1 ]
Function oNonEmptyCellsinRange(oRange, sep$)
	Dim oCell
	Dim orangeQuery
	Dim oAddress()
	Dim oAd
	Dim i as Long
	Dim nRow as Long
	Dim nCol as Long
		oRangeQuery =oRange.queryContentCells(com.sun.star.sheet.CellFlags.VALUE OR _
												com.sun.star.sheet.CellFlags.DATETIME OR _
												com.sun.star.sheet.CellFlags.STRING OR _
												com.sun.star.sheet.CellFlags.FORMULA)
		oAddress() = oRangeQuery.getRangeAddresses()
		for i = 0 to UBound(oAddress())
			oAd = oAddress(i)
			for nRow = oAddress(i).StartRow to oAddress(i).EndRow
				for nCol = oAddress(i).StartColumn to oAddress(i).EndColumn
					oCell = oRange.Spreadsheet.getCellByPosition(nCol,nRow)
					oDisp = oDisp & PrintableAddressOfCell(oCell) & sep$
				next nCol
			next nRow
		next i
	oNonEmptyCellsinRange = oDisp
End Function

'[ Function2 ]
Function PrintableAddressOfCell(oCell) as String
	If IsNull(oCell) OR IsEmpty(oCell) then
		PrintableAddressOfCell = "Unknown"
	else
		PrintableAddressOfCell =oCell.getSpreadSheet().getName & " : " & _
			ColumnNumberToString(oCell.CellAddress.Column) & _
			CStr(oCell.CellAddress.Row+1)
	End If
End Function
'
'[ Function3 ]
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

CCQ-)[Calc]空白のCell Address取得


Sub QueryEmpCellRange()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oRange as Object
	Dim oEmptyCellObj as Object
	Dim oCellAddr as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 3
			for k = 0 to 5
				oCell = oSheet.getCellByPosition( i, k )
				if k = 2 or k = 3 or k = 4 then
					if i = 1 then
						' Empty
					else
						oCell.String = CStr("A" & i + k)
					end if
				else
					oCell.String = CStr( i * k )
				end if
			next k
		next i
		'
		' EmptyCell Object取得
		oRange = oSheet.getCellRangeByName("A1:D6")
		oEmptyCellObj = oRange.queryEmptyCells()
		'
		oDisp = "[ Address of Empty Cell ]" & Chr$(10) & " Addresses of Empty Cell " & Chr$(10) & "  ↓"
		oCellAddr = oEmptyCellObj.getRangeAddresses()
		'
		for i = 0 to UBound(oCellAddr)
			for j = oCellAddr(i).StartColumn to oCellAddr(i).EndColumn
				for k = oCellAddr(i).StartRow to oCellAddr(i).EndRow
					oDisp = oDisp & Chr$(10) & "( " & j & ", " & k & " )" 
				next k
			next j
		next i
		msgbox oDisp,0,"Empty Cell"
End Sub

CCQ-)[Calc]指定範囲内でC2:C6に関連するCell Addrss取得1

Sub oQueryRange
	Dim oCell
	Dim oCellAddress
	Dim oRange
	Dim oSheet
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:G20")
	'CLear
		oClearFlag = com.sun.star.sheet.CellFlags.VALUE OR _
						com.sun.star.sheet.CellFlags.DATETIME OR _
						com.sun.star.sheet.CellFlags.STRING OR _
						com.sun.star.sheet.CellFlags.ANNOTATION OR _
						com.sun.star.sheet.CellFlags.FORMULA OR _
						com.sun.star.sheet.CellFlags.HARDATTR OR _
						com.sun.star.sheet.CellFlags.STYLES OR _
						com.sun.star.sheet.CellFlags.OBJECTS OR _
						com.sun.star.sheet.CellFlags.EDITATTR 
		oRange.clearContents(oClearFlag)
	'Value Input
		for i= 1 to 5
			oCell = oSheet.getCellByPosition(1,i)
				oCell.setValue( i )
			oCell = oSheet.getCellByPosition(2,i)
				oCell.setFormula ( "=B" & CStr(i+1) & " + 1")
			oCell = oSheet.getCellByPosition(3,i)
				oCell.setFormula ( "=C" & CStr(i+1) & " - 1")
		next i
		oCell = oSheet.getCellByPosition(1,6)
			oCell.setFormula ( "=SUM(B2:B5)")
		oCell = oSheet.getCellByPosition(2,6)
			oCell.setFormula ( "=SUM(C2:C6)")
		oCell = oSheet.getCellByPosition(2,0)
			oCell.setFormula ( "=B1 - 1")
		oCell = oSheet.getCellByPosition(1,0)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(1,7)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(4,2)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(4,7)
			oCell.setValue(2)
	'queryPrecedents
		oCell = oSheet.getCellRangeByName("C2:C6")
		oDisp = oDisp & "oCell.queryPredents(false).getRangeAddressesAsString()  => " & _
					oCell.queryPrecedents(false).getRangeAddressesAsString() & Chr$(10)
		oDisp = oDisp & Chr$(10)
	Msgbox(oDisp,0,"Manipulating A Range")
End Sub

CCQ-)[Calc]指定範囲内でC2:C6に関連するCell Addrss取得2

Sub oQueryRange
	Dim oCell
	Dim oCellAddress
	Dim oRange
	Dim oSheet
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:G20")
	'CLear
		oClearFlag = com.sun.star.sheet.CellFlags.VALUE OR _
						com.sun.star.sheet.CellFlags.DATETIME OR _
						com.sun.star.sheet.CellFlags.STRING OR _
						com.sun.star.sheet.CellFlags.ANNOTATION OR _
						com.sun.star.sheet.CellFlags.FORMULA OR _
						com.sun.star.sheet.CellFlags.HARDATTR OR _
						com.sun.star.sheet.CellFlags.STYLES OR _
						com.sun.star.sheet.CellFlags.OBJECTS OR _
						com.sun.star.sheet.CellFlags.EDITATTR 
		oRange.clearContents(oClearFlag)
	'Value Input
		for i= 1 to 5
			oCell = oSheet.getCellByPosition(1,i)
				oCell.setValue( i )
			oCell = oSheet.getCellByPosition(2,i)
				oCell.setFormula ( "=B" & CStr(i+1) & " + 1")
			oCell = oSheet.getCellByPosition(3,i)
				oCell.setFormula ( "=C" & CStr(i+1) & " - 1")
		next i
		oCell = oSheet.getCellByPosition(1,6)
			oCell.setFormula ( "=SUM(B2:B5)")
		oCell = oSheet.getCellByPosition(2,6)
			oCell.setFormula ( "=SUM(C2:C6)")
		oCell = oSheet.getCellByPosition(2,0)
			oCell.setFormula ( "=B1 - 1")
		oCell = oSheet.getCellByPosition(1,0)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(1,7)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(4,2)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(4,7)
			oCell.setValue(2)
	'queryPrecedents
		oCell = oSheet.getCellRangeByName("C2:C6")
		oDisp = oDisp & "oCell.queryPredents(true).getRangeAddressesAsString()  => " & _
					oCell.queryPrecedents(true).getRangeAddressesAsString() & Chr$(10)
		oDisp = oDisp & Chr$(10) & Chr$(10)
	Msgbox(oDisp,0,"Manipulating A Range")
End Sub

CCQ-)[Calc]指定範囲内でB3に依存するCell Addrss取得

Sub oQueryRange
	Dim oCell
	Dim oCellAddress
	Dim oRange
	Dim oSheet
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:G20")
	'CLear
		oClearFlag = com.sun.star.sheet.CellFlags.VALUE OR _
						com.sun.star.sheet.CellFlags.DATETIME OR _
						com.sun.star.sheet.CellFlags.STRING OR _
						com.sun.star.sheet.CellFlags.ANNOTATION OR _
						com.sun.star.sheet.CellFlags.FORMULA OR _
						com.sun.star.sheet.CellFlags.HARDATTR OR _
						com.sun.star.sheet.CellFlags.STYLES OR _
						com.sun.star.sheet.CellFlags.OBJECTS OR _
						com.sun.star.sheet.CellFlags.EDITATTR 
		oRange.clearContents(oClearFlag)
	'Value Input
		for i= 1 to 5
			oCell = oSheet.getCellByPosition(1,i)
				oCell.setValue( i )
			oCell = oSheet.getCellByPosition(2,i)
				oCell.setFormula ( "=B" & CStr(i+1) & " + 1")
			oCell = oSheet.getCellByPosition(3,i)
				oCell.setFormula ( "=C" & CStr(i+1) & " - 1")
		next i
		oCell = oSheet.getCellByPosition(1,6)
			oCell.setFormula ( "=SUM(B2:B5)")
		oCell = oSheet.getCellByPosition(2,6)
			oCell.setFormula ( "=SUM(C2:C6)")
		oCell = oSheet.getCellByPosition(2,0)
			oCell.setFormula ( "=B1 - 1")
		oCell = oSheet.getCellByPosition(1,0)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(1,7)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(4,2)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(4,7)
			oCell.setValue(2)
	'
		oCell = oSheet.getCellByPosition(1,2)
		oDisp = oDisp & "oCell.queryDependents(true).getRangeAddressesAsString()  => " & _
								oCell.queryDependents(true).getRangeAddressesAsString()  & Chr$(10)
	'	
		oDisp = oDisp & Chr$(10) & Chr$(10)
	Msgbox(oDisp,0,"Manipulating A Range")
End Sub

CCQ-)[Calc]指定範囲内でB3と値が異なるCellAddress取得1

Sub oQueryRange
	Dim oCell
	Dim oCellAddress
	Dim oRange
	Dim oSheet
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:G20")
	'CLear
		oClearFlag = com.sun.star.sheet.CellFlags.VALUE OR _
						com.sun.star.sheet.CellFlags.DATETIME OR _
						com.sun.star.sheet.CellFlags.STRING OR _
						com.sun.star.sheet.CellFlags.ANNOTATION OR _
						com.sun.star.sheet.CellFlags.FORMULA OR _
						com.sun.star.sheet.CellFlags.HARDATTR OR _
						com.sun.star.sheet.CellFlags.STYLES OR _
						com.sun.star.sheet.CellFlags.OBJECTS OR _
						com.sun.star.sheet.CellFlags.EDITATTR 
		oRange.clearContents(oClearFlag)
	'Value Input
		for i= 1 to 5
			oCell = oSheet.getCellByPosition(1,i)
				oCell.setValue( i )
			oCell = oSheet.getCellByPosition(2,i)
				oCell.setFormula ( "=B" & CStr(i+1) & " + 1")
			oCell = oSheet.getCellByPosition(3,i)
				oCell.setFormula ( "=C" & CStr(i+1) & " - 1")
		next i
		oCell = oSheet.getCellByPosition(1,6)
			oCell.setFormula ( "=SUM(B2:B5)")
		oCell = oSheet.getCellByPosition(2,6)
			oCell.setFormula ( "=SUM(C2:C6)")
		oCell = oSheet.getCellByPosition(2,0)
			oCell.setFormula ( "=B1 - 1")
		oCell = oSheet.getCellByPosition(1,0)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(1,7)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(4,2)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(4,7)
			oCell.setValue(2)
	'queryPrecedents
		oCell = oSheet.getCellRangeByName("C2:C6")
		oDisp = oDisp & "oCell.queryPredents(false).getRangeAddressesAsString()  => " & _
					oCell.queryPrecedents(false).getRangeAddressesAsString() & Chr$(10)
		oDisp = oDisp & Chr$(10)
		oDisp = oDisp & "oCell.queryPredents(true).getRangeAddressesAsString()  => " & _
					oCell.queryPrecedents(true).getRangeAddressesAsString() & Chr$(10)
		oDisp = oDisp & Chr$(10) & Chr$(10)
	'
		oCell = oSheet.getCellByPosition(1,2)
		oDisp = oDisp & "oCell.queryDependents(true).getRangeAddressesAsString()  => " & _
								oCell.queryDependents(true).getRangeAddressesAsString()  & Chr$(10)
	'	
		oDisp = oDisp & Chr$(10) & Chr$(10)
	'
	oCellAddress = oCell.CellAddress
	'queryColumnDifferences / queryRowDifferences
		oDisp = oDisp & "[ " & oCell.value & " ]" & Chr$(10)
		oDisp = oDisp & "oRange.queryColumnDifferences(oCellAddress).getRangeAddressesAsString() => " & _
					oRange.queryColumnDifferences(oCellAddress).getRangeAddressesAsString() & Chr$(10)
		oDisp = oDisp & Chr$(10)
	Msgbox(oDisp,0,"Manipulating A Range")
End Sub

CCQ-)[Calc]指定範囲内でB3と値が異なるCellAddress取得2

Sub oQueryRange
	Dim oCell
	Dim oCellAddress
	Dim oRange
	Dim oSheet
		oSheet = ThisComponent.Sheets(1)
		oRange = oSheet.getCellRangeByName("A1:G20")
	'CLear
		oClearFlag = com.sun.star.sheet.CellFlags.VALUE OR _
						com.sun.star.sheet.CellFlags.DATETIME OR _
						com.sun.star.sheet.CellFlags.STRING OR _
						com.sun.star.sheet.CellFlags.ANNOTATION OR _
						com.sun.star.sheet.CellFlags.FORMULA OR _
						com.sun.star.sheet.CellFlags.HARDATTR OR _
						com.sun.star.sheet.CellFlags.STYLES OR _
						com.sun.star.sheet.CellFlags.OBJECTS OR _
						com.sun.star.sheet.CellFlags.EDITATTR 
		oRange.clearContents(oClearFlag)
	'Value Input
		for i= 1 to 5
			oCell = oSheet.getCellByPosition(1,i)
				oCell.setValue( i )
			oCell = oSheet.getCellByPosition(2,i)
				oCell.setFormula ( "=B" & CStr(i+1) & " + 1")
			oCell = oSheet.getCellByPosition(3,i)
				oCell.setFormula ( "=C" & CStr(i+1) & " - 1")
		next i
		oCell = oSheet.getCellByPosition(1,6)
			oCell.setFormula ( "=SUM(B2:B5)")
		oCell = oSheet.getCellByPosition(2,6)
			oCell.setFormula ( "=SUM(C2:C6)")
		oCell = oSheet.getCellByPosition(2,0)
			oCell.setFormula ( "=B1 - 1")
		oCell = oSheet.getCellByPosition(1,0)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(1,7)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(4,2)
			oCell.setValue( 2 )
		oCell = oSheet.getCellByPosition(4,7)
			oCell.setValue(2)
	'queryPrecedents
		oCell = oSheet.getCellRangeByName("C2:C6")
		oDisp = oDisp & "oCell.queryPredents(false).getRangeAddressesAsString()  => " & _
					oCell.queryPrecedents(false).getRangeAddressesAsString() & Chr$(10)
		oDisp = oDisp & Chr$(10)
		oDisp = oDisp & "oCell.queryPredents(true).getRangeAddressesAsString()  => " & _
					oCell.queryPrecedents(true).getRangeAddressesAsString() & Chr$(10)
		oDisp = oDisp & Chr$(10) & Chr$(10)
	'
		oCell = oSheet.getCellByPosition(1,2)
		oDisp = oDisp & "oCell.queryDependents(true).getRangeAddressesAsString()  => " & _
								oCell.queryDependents(true).getRangeAddressesAsString()  & Chr$(10)
	'	
		oDisp = oDisp & Chr$(10) & Chr$(10)
	'
	oCellAddress = oCell.CellAddress
	'queryColumnDifferences / queryRowDifferences
		oDisp = oDisp & "[ " & oCell.value & " ]" & Chr$(10)
		oDisp = oDisp & "oRange.queryRowDifferences(oCellAddress).getRangeAddressesAsString() => " & _
					oRange.queryRowDifferences(oCellAddress).getRangeAddressesAsString()
	Msgbox(oDisp,0,"Manipulating A Range")
End Sub

CCQ-)[Calc]2つの範囲で重なる範囲Address取得


Sub QryIntSec()
	Dim oDoc as Object, oSheet as Object
	Dim oRange as Object
	Dim oTbRng as Object
	Dim oIntSecObj as Object
	Dim oCellAddr as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		'
		' 重なる対象範囲 ( com.sun.star.table.CellRangeAddress )
		oTbRng = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oTbRng
			.Sheet = 0
			.StartColumn = 2	' Col C
  			.StartRow = 3			' Row No.4
  			.EndColumn = 5		' Col F
  			.EndRow = 8			' Row No.8
		end with
		'
		' Intersection Object取得
		oRange = oSheet.getCellRangeByName("A1:D6")
		oIntSecObj = oRange.queryIntersection(oTbRng)
		'
		oDisp = "[ Intersection of Range ]" & Chr$(10) & "(A1:D6)と(C4:F9)の重複範囲" & Chr$(10) & "  ↓"
		oCellAddr = oIntSecObj.getRangeAddresses()
		'
		for i = 0 to UBound(oCellAddr)
			for j = oCellAddr(i).StartColumn to oCellAddr(i).EndColumn
				for k = oCellAddr(i).StartRow to oCellAddr(i).EndRow
					oDisp = oDisp & Chr$(10) & "( " & j & ", " & k & " )" 
				next k
			next j
		next i
		msgbox oDisp,0,"Intersection "
End Sub
'
' [ Note ]
' Target Rangeは com.sun.star.table.CellRangeAddress である事に注意。LibreOffice / Apache OpenOffice

CCQ-)[Calc]表示CellのAddress取得


Sub QryVisibleCell()
	Dim oDoc as Object, oSheet as Object, oCell as Object
	Dim oRange as Object
	Dim oVisibleCellObj as Object
	Dim oCellAddr as Object
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		for i = 0 to 3
			for k = 0 to 5
				oCell = oSheet.getCellByPosition( i, k )
				oCell.String = CStr( i * k )
			next k
		next i
		'
		' Set InVisible
		oSheet.Columns(1).isVisible = false
		oSheet.Columns(2).isVisible = false
		oSheet.Rows(1).isVisible = false
		oSheet.Rows(3).isVisible = false
		oSheet.Rows(4).isVisible = false
		'
		' VisibleCell Object取得
		oRange = oSheet.getCellRangeByName("A1:D6")
		oVisibleCellObj = oRange.queryVisibleCells()
		'
		oDisp = "[ Address of Visible Cell ]" & Chr$(10) & "Range =  A1:D6 の表示Cell" & Chr$(10) & "  ↓"
		oCellAddr = oVisibleCellObj.getRangeAddresses()
		'
		for i = 0 to UBound(oCellAddr)
			for j = oCellAddr(i).StartColumn to oCellAddr(i).EndColumn
				for k = oCellAddr(i).StartRow to oCellAddr(i).EndRow
					oDisp = oDisp & Chr$(10) & "( " & j & ", " & k & " )" 
				next k
			next j
		next i
		msgbox oDisp,0,"Visible Cell"
End Sub

CCQ-)[Calc]Formula Cell取得


Sub CalcQuery()
	Dim oDoc as Object, oSheet as Object
	Dim oRange as Object
	Dim oFormulaCell as Object
	Dim oCells as Object, oEnum as Object, oElmt as Object
	Dim oAddrStr as String
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oRange = oSheet.getCellRangeByName("A1:D6")
		' Formula Cell取得
		oFormulaCell = oRange.queryFormulaCells(1)
		' Cell Objectを取得
		oCells = oFormulaCell.getCells()
		oEnum = oCells.createEnumeration()
		nn = 0
		oDisp = "[ A1:D6 / Formula Cell ]" & Chr$(10) & "1) VALUE"
		Do While oEnum.hasMoreElements()
			oElmt = oEnum.nextElement()
			oAddrStr = oElmt.AbsoluteName
			oDisp = oDisp & Chr$(10) & oAddrStr
			nn = nn + 1
			if nn > 1000 then
				Exit Do
			end if
		Loop
		'
		oFormulaCell = oRange.queryFormulaCells(2)
		' Cell Objectを取得
		oCells = oFormulaCell.getCells()
		oEnum = oCells.createEnumeration()
		nn = 0
		oDisp = oDisp & Chr$(10) & Chr$(10) & "2) STRING"
		Do While oEnum.hasMoreElements()
			oElmt = oEnum.nextElement()
			oAddrStr = oElmt.AbsoluteName
			oDisp = oDisp & Chr$(10) & oAddrStr
			nn = nn + 1
			if nn > 1000 then
				Exit Do
			end if
		Loop
		'
		oFormulaCell = oRange.queryFormulaCells(4)
		' Cell Objectを取得
		oCells = oFormulaCell.getCells()
		oEnum = oCells.createEnumeration()
		nn = 0
		oDisp = oDisp & Chr$(10) & Chr$(10) & "3) ERROR"
		Do While oEnum.hasMoreElements()
			oElmt = oEnum.nextElement()
			oAddrStr = oElmt.AbsoluteName
			oDisp = oDisp & Chr$(10) & oAddrStr
			nn = nn + 1
			if nn > 1000 then
				Exit Do
			end if
		Loop
		'
		oFormulaCell = oRange.queryFormulaCells(2+4)
		' Cell Objectを取得
		oCells = oFormulaCell.getCells()
		oEnum = oCells.createEnumeration()
		nn = 0
		oDisp = oDisp & Chr$(10) & Chr$(10) & "4) STRING + ERROR"
		Do While oEnum.hasMoreElements()
			oElmt = oEnum.nextElement()
			oAddrStr = oElmt.AbsoluteName
			oDisp = oDisp & Chr$(10) & oAddrStr
			nn = nn + 1
			if nn > 1000 then
				Exit Do
			end if
		Loop
		'
		msgbox oDisp,0,"Formula Cell / getCells"
End Sub
'
' [ Note ]
' com.sun.star.sheet.FormulaResultLibreOffice / Apache OpenOffice )
' VALUE  = 1 
' String = 2
' ERROR  = 3
' 値はLONG値 

CCQ-)[Calc]指定Contents Cell取得


Sub CalcQuery()
	Dim oDoc as Object, oSheet as Object
	Dim oRange as Object
	Dim oFormulaCell as Object
	Dim oCells as Object, oEnum as Object, oElmt as Object
	Dim oAddrStr as String
	Dim oDisp as String
		oDoc = ThisComponent
		oSheet = oDoc.getSheets().getByIndex(0)
		oRange = oSheet.getCellRangeByName("A1:D6")
		' Formula Cell取得
		oFormulaCell = oRange.queryContentCells(2)
		' Cell Objectを取得
		oCells = oFormulaCell.getCells()
		oEnum = oCells.createEnumeration()
		nn = 0
		oDisp = "[ A1:D6 / Content Cell ]" & Chr$(10) & "1) DATETIME"
		Do While oEnum.hasMoreElements()
			oElmt = oEnum.nextElement()
			oAddrStr = oElmt.AbsoluteName
			oDisp = oDisp & Chr$(10) & oAddrStr
			nn = nn + 1
			if nn > 1000 then
				Exit Do
			end if
		Loop
		'
		oFormulaCell = oRange.queryContentCells(8)
		' Cell Objectを取得
		oCells = oFormulaCell.getCells()
		oEnum = oCells.createEnumeration()
		nn = 0
		oDisp = oDisp & Chr$(10) & Chr$(10) & "2) ANNOTATION"
		Do While oEnum.hasMoreElements()
			oElmt = oEnum.nextElement()
			oAddrStr = oElmt.AbsoluteName
			oDisp = oDisp & Chr$(10) & oAddrStr
			nn = nn + 1
			if nn > 1000 then
				Exit Do
			end if
		Loop
		'
		oFormulaCell = oRange.queryContentCells(4+16)
		' Cell Objectを取得
		oCells = oFormulaCell.getCells()
		oEnum = oCells.createEnumeration()
		nn = 0
		oDisp = oDisp & Chr$(10) & Chr$(10) & "3) STRING + FORMULA"
		Do While oEnum.hasMoreElements()
			oElmt = oEnum.nextElement()
			oAddrStr = oElmt.AbsoluteName
			oDisp = oDisp & Chr$(10) & oAddrStr
			nn = nn + 1
			if nn > 1000 then
				Exit Do
			end if
		Loop
		'
		msgbox oDisp,0,"Content Cell / getCells"
End Sub
'
' [ Note ]
' com.sun.star.sheet.CellFlags( LibreOffice / Apache OpenOffice )
' ANNOTATION は ANNOTATION削除の時に利用。

CCQ-)[Calc]











Top of Page

inserted by FC2 system