Sub InsertCellRow()
Dim Doc As Object
Dim Sheet As Object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim iStart as integer
Dim iRows as integer
Dim iSheetindex as integer
iSheetindex = 0
iStart = 0
iRows=3
Sheet =ThisComponent.getSheets().getByIndex(iSheetindex)
CellRangeAddress.Sheet = iSheetindex
CellRangeAddress.StartColumn = 0
CellRangeAddress.StartRow = iStart
CellRangeAddress.EndColumn = 2
CellRangeAddress.EndRow = iStart + iRows-1
Sheet.insertCells(CellRangeAddress, com.sun.star.sheet.CellInsertMode.ROWS)
End Sub
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
Sub InsertCellColumn()
Dim Doc As Object
Dim Sheet As Object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim iStart as integer
Dim iRows as integer
Dim iSheetindex as integer
iSheetindex = 0
iStart = 0
iRows=3
Sheet =ThisComponent.getSheets().getByIndex(iSheetindex)
CellRangeAddress.Sheet = iSheetindex
CellRangeAddress.StartColumn = 0
CellRangeAddress.StartRow = iStart
CellRangeAddress.EndColumn = 2
CellRangeAddress.EndRow = iStart + iRows-1
Sheet.insertCells(CellRangeAddress, com.sun.star.sheet.CellInsertMode.COLUMNS)
End Sub
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
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
Sub oDeleteCellUp()
Dim Doc As Object, oSheet As Object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim iStart as integer
Dim iRows as integer
Dim iSheetindex as integer
iSheetindex = 0
iStart = 0
iRows=3
oSheet=ThisComponent.getSheets().getByIndex(iSheetindex)
CellRangeAddress.Sheet = iSheetindex
CellRangeAddress.StartColumn = 0
CellRangeAddress.StartRow = iStart
CellRangeAddress.EndColumn = 2
CellRangeAddress.EndRow = iStart + iRows-1
oSheet.insertCells(CellRangeAddress, com.sun.star.sheet.CellDeleteMode.ROWS)
End Sub
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
Sub CalcDeleteCell()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp1(0) as new com.sun.star.beans.PropertyValue
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc=ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oProp1(0).Name = "ToPoint"
oProp1(0).Value = "A1:B6"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
oProp(0).Name = "Flags"
oProp(0).Value = "R"
oDispatcher.executeDispatch(oFrame, ".uno:DeleteCell", "", 0, oProp())
msgbox "Success"
End Sub
'
' [ Flag Value ]
' U : Cell を 上に移動
' L : Cell を 左に移動
' R : 行全体を削除
' C : 列全体を削除
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
Sub oDeleteCellLeft()
Dim Doc As Object, oSheet As Object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim iStart as integer
Dim iRows as integer
Dim iSheetindex as integer
iSheetindex = 0
iStart = 0
iRows=3
oSheet =ThisComponent.getSheets().getByIndex(iSheetindex)
CellRangeAddress.Sheet = iSheetindex
CellRangeAddress.StartColumn = 0
CellRangeAddress.StartRow = iStart
CellRangeAddress.EndColumn = 2
CellRangeAddress.EndRow = iStart + iRows-1
oSheet.insertCells(CellRangeAddress, com.sun.star.sheet.CellDeleteMode.COLUMNS)
End Sub
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
Sub CalcDeleteCell()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp1(0) as new com.sun.star.beans.PropertyValue
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc=ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oProp1(0).Name = "ToPoint"
oProp1(0).Value = "A1:B6"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
oProp(0).Name = "Flags"
oProp(0).Value = "C"
oDispatcher.executeDispatch(oFrame, ".uno:DeleteCell", "", 0, oProp())
msgbox "Success"
End Sub
'
' [ Flag Value ]
' U : Cell を 上に移動
' L : Cell を 左に移動
' R : 行全体を削除
' C : 列全体を削除
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
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
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
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は無い
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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である。
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
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。式値は含まれる。
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
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
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
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
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
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
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
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
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
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
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
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からの実行では反映しない。
'
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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値
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削除の時に利用。
Sub UnoInsertCell()
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 = "B3:C5"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oProp(0).Name = "Flags"
oProp(0).Value = "R"
oDispatcher.executeDispatch(oFrame, ".uno:InsertCell", "", 0, oProp())
'
msgbox "Success", 0,"Uno / Insert"
End Sub
'
' [ Note ]
' R : 行全体を下に移動
' C : 列全体を右に移動
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
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
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
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は無い
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
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
Sub RowSelection()
Dim oDoc as Object
Dim oSheet as Object
Dim oRange as Object
Dim objRow as Object, objCol as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oRange = oSheet.getCellRangeByName("B2:D3")
' oRange = oSheet.getCellRangeByPosition(1,1,3,2) ' (sCol, sRow, eCol, eRow)
objRow = oRange.getRows()
objCol = oRange.getColumns()
'
objRow.IsVisible = False
objCol.IsVisible = False
msgbox("2～3行とB～D列を非表示",0,"LO7.0.4.2")
'
objRow.IsVisible = True
objCol.IsVisible = True
msgbox("2～3行とB～D列を表示",0,"LO7.0.4.2")
End Sub
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
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
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
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
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
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
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
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
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
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
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
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は１つしか無いので 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
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
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
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
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
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
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
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 ]
' 検索窓で検索した条件が用いられる。検索窓から検索しないと、検索対象は空白になる。
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
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
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。式値は含まれる。
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
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
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
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
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
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
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
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
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列の結果を示す )
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列)に第二引数にすると表示が違う？
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
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は消えない。
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実行
' 0以下の値の場合、"Bad" Formatを適用
'
Sub oSetConditionalStyle()
Dim oSheets as Object
Dim oRange as Object
Dim oConFormat as Object
Dim oCondition(2) as new com.sun.star.beans.PropertyValue
oSheets = ThisComponent.Sheets(0)
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 = "Bad"
oConFormat.clear()
oConFormat.addNew(oCondition())
oRange.ConditionalFormat = oConFormat
msgbox "Success"
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にならない式
' Todayから7日前の期間の場合、"Good" Formatを適用
'
Sub oSetConditionalStyle()
Dim oSheets as Object
Dim oRange as Object
Dim oConFormat as Object
Dim oCondition(3) as new com.sun.star.beans.PropertyValue
oSheets = ThisComponent.Sheets(0)
oRange = oSheets.getCellRangeByName("A1:D10")
'Obtain the Validation object
oConFormat = oRange.ConditionalFormat
oCondition(0).Name = "Operator"
oCondition(0).Value = com.sun.star.sheet.ConditionOperator.BETWEEN
oCondition(1).Name = "Formula1"
oCondition(1).Value = "Today()"
oCondition(2).Name = "Formula2"
oCondition(2).Value = "Today()-7"
oCondition(3).Name = "StyleName"
oCondition(3).Value = "Good"
oConFormat.clear()
oConFormat.addNew(oCondition())
oRange.ConditionalFormat = oConFormat
msgbox "Success"
End Sub
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を区切り文字にすると、１つのDataになる場合があるので避けた方がBetter。
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」である事に注意。
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
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の増分値
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"は設定無しと同じ
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
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
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
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
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
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
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
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
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
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
Sub oCalcReCalculation()
Dim oDoc as Object
oDoc = ThisComponent
' ReCalculation
oDoc.calculateAll()
'
msgbox "Success"
End Sub
'
' [ 注意事項 ]
1) Default では図の 「ツール」→「セルの内容」→「自動計算」にCheckが入っているので、
Macroの効果を確認する為には事前にCheckを外しておく。
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
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
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を参照。
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
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
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
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
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
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
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
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
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
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
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
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
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値
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削除の時に利用。