Home of site
Macroの杜
(OpenOffice.org/LibreOffice Basic編)
Calc No.1
**********************【 Index 】**********************
Cell
[ General ]
[ Insert･Delete.Copy ]
[ Property(Cellの書式設定) ]
{{ Format }}
{{ Font }}
{{ Font Effet }}[ Refer to "Font / 文字関連の Property 一覧" ]
{{ Position / Size }}
{{ BorderLine }}
{{ Protection }}
{{ Color }}
{{ autoFormat }}
{{ Annotation( Comment ) }}
[ Claer(内容の削除) ]
[ Selection ]
[ Address(セル番地) ]
[ Column･Row(行・列) ]
[ HyperLink(ハイパーリンク) ]
[ Array ]
[ Sort(並び替え) ]
[ Filter ]
[ Search ]
[ Merge(結合) ]
[ Calc Function ]
[ Subtotal of Column ]
[ 入力規則 / 条件付き書式 ]
[ 連続Data / Fill ]
[ Recalcuation( 再計算 ) ]
[ Tokens ]
[ Name Range ]
Query[ com.sun.star.sheet.XCellRangesQuery Inteface( LibreOffice / Apache OpenOffice ) ]
###【 Following Calc No.2( Sheet / View / File etc ) 】###
**********************【 Macro Code 】**********************
Cell操作
[ General ]
CCB-)[Calc]Cellに値(数字 ＆ 文字列 ＆ 式)を代入する(1)
Sub EnetrCell()
ThisComponent.Sheets(0).getCellByPosition(0,0).value=1 '←セルA1に数値の1を入力
ThisComponent.Sheets(0).getCellByPosition(0,1).String="test" '←セルA2に文字列のtestを入力
ThisComponent.Sheets(0).getCellByPosition(0,2).Formula="=A1*10" '←セルA3に式( =A1* 10)を入力
End Sub
'
[解説]
ThisComponentは本file。Excel風に言うとWorkBooks(1)。
Sheets(0)はSheet１の事( 正確には .getSheets().getByIndex(0) )。Excel風に言うとWorkSheets(1)。
但しExcelのsheet名をTestに変更するとWorkSheets("test")であるが、Calcの場合はSheet名がtestになってもSheets(0)であり、
Sheets("test")ではErrorになる。
Sheet名で指定する場合は getSheets().getByName("test")となる。
ThisComponent.Sheets(0).getCellByPosition(0,0).value=1はSheet1のセルA1に数値データ（value)型の1が入力されるという事。
Excel風に言うとWorkbooks(1).Worksheets(1).cells(1,1)=1。
同じくThisComponent.Sheets(0).getCellByPosition(0,1).String="test"はセルA2に文字列型データ(String)の"test"が入力される。
ここで、VBAではcells(行,列)であるが、OpenOffice BasicではgetCellByPosition(列,行)である事に注意。
つまり、上記をExcel VBAにて表すと以下の様になる。
[Excel VBAでの記述]
Sub main21()
Workbooks(1).Worksheets(1).Cells(1, 1) = 1
Workbooks(1).Worksheets(1).Cells(2, 1) = "test"
End Sub
CCB-)[Calc]Cellに値(数字 ＆ 文字列 ＆ 式)を代入する(2)
Sub EnterCell()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oProp(0).Name = "StringName"
oProp(0).Value = "1"
oDispatcher.executeDispatch(oFrame, ".uno:EnterString", "", 0, oProp())
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A2"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oProp(0).Name = "StringName"
oProp(0).Value = "test"
oDispatcher.executeDispatch(oFrame, ".uno:EnterString", "", 0, oProp())
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A3"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oProp(0).Name = "StringName"
oProp(0).Value = "=A1*10"
oDispatcher.executeDispatch(oFrame, ".uno:EnterString", "", 0, oProp())
'
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
CCB-)[Calc]Cellに値(数字 ＆ 文字列 ＆ 式)を代入する(3)
Sub CalcBasic()
Dim oDoc as Object, oSheet as Object
Dim oCell1 as Object, oCell2 as Object, oCell3 as Object
oDoc = ThisComponent
'
oSheet = oDoc.getSheets().getByName("Sheet1")
'
oCell1 = oSheet.getCellRangeByName("A1")
oCell2 = oSheet.getCellRangeByName("A3")
oCell3 = oSheet.getCellRangeByName("A5")
'
oCell1.String = "Test1"
oCell2.Value = 10
oCell3.Formula = "=A3*5 "
msgbox "Success"
End Sub
CCB-)[Calc]Cellから値を取得する
Sub CetCellVauleString()
Dim oDoc as Object
Dim oSheet as Object
Dim oCellType as Long
Dim oCell(3) as Variant
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
oDisp = "[ Cell 値取得 ]" & Chr$(10)
for i = 0 to 3
oCellType = oSheet.getCellByPosition(0, i ).getType()
Select Case oCellType
case com.sun.star.table.CellContentType.EMPTY
oCell( i ) = "空白です。"
case com.sun.star.table.CellContentType.VALUE
oCell( i ) = oSheet.getCellByPosition(0, i ).Value
case com.sun.star.table.CellContentType.TEXT
oCell( i ) = oSheet.getCellByPosition(0, i ).String
case com.sun.star.table.CellContentType.FORMULA
oCell( i ) = oSheet.getCellByPosition(0, i ).Formula
case Else
oCell( i ) = "不正な型のDataです。"
End Select
'
oDisp = oDisp & "A" & i & " Cell の値 : " & oCell( i ) & Chr$(10)
next i
msgbox(oDisp,0,"各Ｃｅｌｌの値")
End Sub
[ Insert･Delete.Copy ]
CCI-)[Calc]Cellの挿入(1)[既存データは下方向に移動]
sub InsertCellDown()
Dim Doc As Object, oSheet As Object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
oDoc = ThisComponent
oSheet =oDoc.getSheets().getByIndex(0)
CellRangeAddress.Sheet = 0
CellRangeAddress.StartColumn = 2
CellRangeAddress.StartRow = 2
CellRangeAddress.EndColumn = 4
CellRangeAddress.EndRow = 4
oSheet.insertCells(CellRangeAddress, com.sun.star.sheet.CellInsertMode.DOWN)
msgbox "Success"
End Sub
CCI-)[Calc]Cellの挿入(1)[既存データは下方向に移動]{2}
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 = "A1" ' "1:1" → 行全体を下げる挿入
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' Insert Cell ( Direction of Existed Cell is Down )
oDispatcher.executeDispatch(oFrame, ".uno:InsertCellsDown", "", 0, Array())
'
msgbox "InsertCellsDown" & Chr$(10) & "(Dispatcher)",0,"Insert Cells"
End Sub
CCI-1)[Calc]Cellの挿入(2)[既存データは右方向に移動]{1}
Sub InsertCellRight()
Dim Doc As Object, oSheet As Object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
oDoc = ThisComponent
oSheet =oDoc.getSheets().getByIndex(0)
CellRangeAddress.Sheet = 0
CellRangeAddress.StartColumn = 2
CellRangeAddress.StartRow = 2
CellRangeAddress.EndColumn = 4
CellRangeAddress.EndRow = 4
oSheet.insertCells(CellRangeAddress, com.sun.star.sheet.CellInsertMode.RIGHT)
msgbox "Success"
End Sub
CCI-)[Calc]Cellの挿入(2)[既存データは右方向に移動]{2}
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 = "A1" ' "A:A" で 列全体を右に移動
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' Insert Cell ( Direction of Existed Cell is Right )
oDispatcher.executeDispatch(oFrame, ".uno:InsertCellsRight", "", 0, Array())
'
msgbox "InsertCellsRight" & Chr$(10) & "(Dispatcher)",0,"Insert Cells"
End Sub
CCI-1)[Calc]Cellの挿入(3)[行全体が下方向に移動]
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
CCI-1)[Calc]Cellの挿入(4)[列全体が右方向に移動]
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
CCI-)[Calc]Cellの挿入(5)
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 = ">"
oDispatcher.executeDispatch(oFrame, ".uno:InsertCell", "", 0, oProp())
'
msgbox "Success", 0,"Uno / Insert"
End Sub
'
' [ Note ]
' V : Cellを下に移動
' > : Cellを右に移動
' R : 行全体を下に移動
' C : 列全体を右に移動
CCI-2)[Calc]Cellの削除(1)[既存データは上方向に移動]
Sub DeleteCellUp()
Dim Doc As Object, oSheet As Object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
oSheet =ThisComponent.getSheets().getByIndex(iSheetindex)
CellRangeAddress.Sheet = 0
CellRangeAddress.StartColumn = 2
CellRangeAddress.StartRow = 2
CellRangeAddress.EndColumn = 5
CellRangeAddress.EndRow = 5
oSheet.removeRange(CellRangeAddress, com.sun.star.sheet.CellDeleteMode.UP)
End Sub
CCI-)[Calc]Cellの削除(2)[既存データは左方向に移動]
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
oDoc = ThisComponent
oSheet =oDoc.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.LEFT)
End Sub
CCI-)[Calc]Cellの削除(3)[行全体が上方向に移動]
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
CCI-)[Calc]Cellの削除(4)[列全体が左方向に移動]
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
CCI-)[Calc]Cellの削除(左･上･行全体･列全体が移動)
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 = "U"
oDispatcher.executeDispatch(oFrame, ".uno:DeleteCell", "", 0, oProp())
msgbox "Success"
End Sub
'
' [ Flag Value ]
' U : Cell を 上に移動
' L : Cell を 左に移動
' R : 行全体を削除
' C : 列全体を削除
CCI-)[Calc]CellのCOPY
Sub oCopyRange
Dim oSHeet
Dim oRangeAddress
Dim oCellAddress
oSheet = ThisComponent.Sheets(1)
oRangeAddress = oSheet.getCellRangeByName("A1:B5").getRangeAddress()
oCellAddress = oSheet.getCellByPosition(2,0).getCellAddress()
oSheet.copyRange(oCellAddress, oRangeAddress)
End SUb
CCI-)[Calc]CellのCOPY2
Sub oCopyData
Dim oDoc as Object
Dim oSheet1, oSheet2 as Object
Dim oCopyData as Object
Dim oCopyRange as Object
Dim oPasteRange as Object
Dim sCol, eCol as Long
Dim sRow, eRow as Long
oDoc = ThisComponent
oSheet1 = oDoc.getSheets().getByIndex(0)
oSheet2 = oDoc.getSheets().getByIndex(1)
sCol = 0
eCol = 10
sRow = 0
eRow = 100
oCopyRange = oSheet1.getCellRangeByPosition(sCol, sRow, eCol, eRow)
oPasteRange = oSheet2.getCellRangeByPosition(sCol, sRow, eCol, eRow)
oCopyData = oCopyRange.getData()
oPasteRange.setData(oCopyData)
End Sub
CCI-)[Calc]Cell範囲のCOPY3
Sub oCopyData
Dim oDoc as Object
Dim oSheet1, oSheet2 as Object
Dim oCopyData as Object
Dim oCopyRange as Object
Dim oPasteRange as Object
Dim sCol, eCol as Long
Dim sRow, eRow as Long
oDoc = ThisComponent
oSheet1 = oDoc.getSheets().getByIndex(0)
oSheet2 = oDoc.getSheets().getByIndex(1)
sCol = 0
eCol = 10
sRow = 0
eRow = 100
oCopyRange = oSheet1.getCellRangeByPosition(sCol, sRow, eCol, eRow)
oPasteRange = oSheet2.getCellRangeByPosition(sCol, sRow, eCol, eRow)
oCopyData = oCopyRange.getDataArray()
oPasteRange.setDataArray(oCopyData)
End Sub
CCI-)[Calc]形式を選択して貼り付け
Sub CopyPaste
Dim oFrame as object
Dim dispatcher as object
'
oFrame = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
dispatcher.executeDispatch(oFrame, ".uno:Copy", "", 0, Array())
'
Dim oArgs2(0) as new com.sun.star.beans.PropertyValue
oArgs2(0).Name = "ToPoint"
oArgs2(0).Value = "$B$5"
dispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oArgs2())
'
Dim oArgs3(5) as new com.sun.star.beans.PropertyValue
oArgs3(0).Name = "Flags"
oArgs3(0).Value = "SDFNT" ' ← 下記" Flag Value "参照
oArgs3(1).Name = "FormulaCommand"
oArgs3(1).Value = 0
oArgs3(2).Name = "SkipEmptyCells"
oArgs3(2).Value = false
oArgs3(3).Name = "Transpose"
oArgs3(3).Value = false
oArgs3(4).Name = "AsLink"
oArgs3(4).Value = false
oArgs3(5).Name = "MoveMode"
oArgs3(5).Value = 4
dispatcher.executeDispatch(oFrame, ".uno:InsertContents", "", 0, oArgs3())
'
msgbox "Success"
End Sub
'
' [ Flag Value ]
' S : String ( テキスト )
' V : Value ( 値 )
' D : Date ( 日付 )
' F : Formula ( 式 )
' N : Note ( コメント )
' T : Format ( 書式 )
' 空白 : Object ( オブジェクト )
' A : 全て
[ Cellの書式設定 ]
CCProp-)[Calc]直接設定した書式の解除
Sub CellProtect()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oDispatcher.executeDispatch(oFrame, ".uno:ResetAttributes", "", 0, Array())
'
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
{{ Format }}
CCF-)[Calc]セルの表示形式キーNo.取得
Sub NumFormatNo()
Dim oDoc as Object
Dim oNumberFormats As Object
Dim oLocale As New com.sun.star.lang.Locale
Dim oDF(12) as String
Dim oKeyNo(12) as Long
oLocale.Language = "ja"
oLocale.Country = "JP"
oDoc = ThisComponent
oNumberFormats = oDoc.NumberFormats
oDF(0) = "#,##0"
oDF(1) = "#,##0.#0"
oDF(2) = "0%"
oDF(3) = "0.00%"
oDF(4) = "[$￥-411]#,##0;-[$￥-411]#,##0"
oDF(5) = "[$￥-411]#,##0;[RED]-[$￥-411]#,##0"
oDF(6) = "YYYY/MM/DD"
oDF(7) = "YYYY年MM月DD日(AAAA)"
oDF(8) = "GE.M.D"
oDF(9) = "HH:MM"
oDF(10) = "HH:MM:SS"
oDF(11) = "0.00E+00"
oDF(12) = "# ??/??"
'
oDisp = "[ Number ] " & Chr$(10)
for i = 0 to 1
oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
next i
oDisp = oDisp & Chr$(10)
'
oDisp = oDisp & "[ Percent ]" & Chr$(10)
for i = 2 to 3
oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
next i
oDisp = oDisp & Chr$(10)
'
oDisp = oDisp & "[ Current ]" & Chr$(10)
for i = 4 to 5
oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
next i
oDisp = oDisp & Chr$(10)
'
oDisp = oDisp & "[ Date ]" & Chr$(10)
for i = 6 to 8
oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
next i
oDisp = oDisp & Chr$(10)
'
oDisp = oDisp & "[ Time ]" & Chr$(10)
for i = 9 to 10
oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
next i
oDisp = oDisp & Chr$(10)
'
oDisp = oDisp & "[ 指数 ]" & Chr$(10)
for i = 11 to 11
oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
next i
oDisp = oDisp & Chr$(10)
'
oDisp = oDisp & "[ 分数 ]" & Chr$(10)
for i = 12 to 12
oKeyNo(i) = oNumberFormats.queryKey( oDF(i), oLocale, false )
oDisp = oDisp & oDF(i) & " => " & oKeyNo(i) & Chr$(10)
next i
'
MsgBox(oDisp, 0,"表示ｷｰNo.")
End Sub
CCF-)[Calc]セル数値の表示形式を設定1
Sub NumberFmt()
Dim oDoc as Object
Dim oSheet as Object
Dim NumberFormats As Object
Dim NumberFormatString As String
Dim NumberFormatId As Long
Dim LocalSettings As New com.sun.star.lang.Locale
'
oDoc=ThisComponent
oSheet=oDoc.getSheets().getByName("sheet1")
oCell=oSheet.getCellByPosition(1,1) '←設定範囲
NumberFormats = oDoc.NumberFormats
NumberFormatString = "#,##0.#0円"
'
NumberFormatId = NumberFormats.queryKey(NumberFormatString, LocalSettings, True)
If NumberFormatId = -1 Then
NumberFormatId = NumberFormats.addNew(NumberFormatString, LocalSettings) '書式コードを追加
End If
oCell.NumberFormat = NumberFormatId
'
msgbox "Success"
End Sub
CCF-)[Calc]セル数値の表示形式を設定2
Sub SetNumFormat()
Dim oNumberFormats As Object
Dim oLocale As New com.sun.star.lang.Locale
oLocale.Language = "ja"
oLocale.Country = "JP"
oDoc = ThisComponent
oSheet = oDoc.getSheets.getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
oCell.value = 10000
oCell.NumberFormat = 5103
End Sub
CCF-)[Calc]セル数値の表示形式を設定3
Sub UnoNumFmt()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "B2"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oProp(0).Name = "NumberFormatValue"
oProp(0).Value = 103
oDispatcher.executeDispatch(oFrame, ".uno:NumberFormatValue", "", 0, oProp())
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
'
' [ Note ]
1) Standard = 0
{ 数字 }
2) 0 = 1
3) 0.00 = 2
4) #,##0 = 3
5) #,##0.00 = 4
6) #,###.00 = 5
{ Percent }
7) 0% = 10
8) 0.00% = 11
{ 通貨 }
9) [$￥-411]#,##0;-[$￥-411]#,##0 = 101
10) [$￥-411]#,##0.00;-[$￥-411]#,##0.00 = 103
11) [$￥-411]#,##0;[RED]-[$￥-411]#,##0 = 103
12) [$￥-411]#,##0.00;[RED]-[$￥-411]#,##0.00 = 104
13) [$￥-411]#,##0.--;[RED]-[$￥-411]#,##0.-- = 105
14) #,##0 [$JPY];[RED]-#,##0 [$JPY] = 110
15) ￥#,##0;-￥#,##0 = 111
16) ￥#,##0.00;-￥#,##0.00 = 20
17) ￥#,##0;[RED]-￥#,##0 = 21
18) ￥#,##0.00;[RED]-￥#,##0.00 = 22
19) #,##0 CCC = 24
20) ￥#,##0.--;[RED]-￥#,##0.-- = 25
{ 日付 }
21) YY/M/D = 30
22) YYYY年MM月DD日（AAAA） = 38
23) YY/MM/DD = 37
24) YYYY/MM/DD = 36
25) YY年M月D日 = 39
26) YYYY年M月D日 = 75
27) GGGE年M月D日 = 80
28) YYYY年M月D日 = 76
29) GGGE年M月D日（AAAA） = 81
30) YY年M月D日（AAA） = 77
31) GGGE年M月D日（AAA） = 31
32) YYYY年M月D日（AAA） = 78
33) YYYY年M月D日（AAAA） = 79
34) MM.DD = 82
35) GE.M.D = 83
36) YYYY-MM-DD = 84
37) YY/MM = 32
38) M月D日 = 33
39) M月 = 34
40) YY年 QQ = 35
41) WW = 85
{ 時刻 }
42) YY/MM/DD HH:MM = 50
43) YYYY/M/D H:MM = 51
44) H:MM = 40
45) HH:MM:SS = 41
46) AM/PM H:MM = 42
47) AM/PM H:MM:SS = 43
48) [HH]:MM:SS = 44
49) MM:SS.00 = 45
50) [HH]:MM:SS.00 = 46
51) YY/MM/DD HH:MM = 50
52) YYYY/M/D H:MM = 51
{ 指数 }
53) 0.00E+000 = 60
54) 0.00E+00 = 61
{ 分数 }
55) # ?/? = 70
56) # ??/?? = 71
{ プール値 }
57) BOOLEAN = 99
{ テキスト }
58) @ = 100
CCF-)[Calc]Content Type of Cell
Sub oContentType()
Dim oDoc
Dim oSheets
Dim oCell
oDoc = ThisComponent
oSheets = oDoc.Sheets(0)
oCell = oSheets.getCellByPosition(1,2)
oType = oCell.getType()
Select Case oType
case com.sun.star.table.CellContentType.EMPTY
oDisp = "Empty"
case com.sun.star.table.CellContentType.VALUE
oDisp = "Value"
case com.sun.star.table.CellContentType.TEXT
oDisp = "Text"
case com.sun.star.table.CellContentType.FORMULA
oDisp = "Formula"
case Else
oDisp = "UnKnown"
End Select
msgbox(oDisp,0,"com.sun.star.table.CellContentType")
End SUb
CCF-)[Calc]User Defined Attributes
Sub oCellPropertiesService()
Dim oSheets
Dim oCell
Dim oUserData
Dim oUserAttr as new com.sun.star.xml.AttributeData
oSheets = ThisComponent.Sheets(1)
oCell =oSheets.getCellByPosition(0,0)
'xray oUserAtrr
oUserAttr.Type ="CDATA"
oUserAttr.Value = "NewOOo3 macro"
oUserData = oCell.UserDefinedAttributes
If NOT oUserData.hasByName("home") then
oUserData.insertByName("home",oUserAttr)
oCell.UserDefinedAttributes = oUserData
End If
'xray oUserData
oUser = oUserData.ElementNames
for i= 0 to UBound(oUser)
oDisp =oDisp & oUser(i) & Chr$(10)
next i
msgbox(oDisp,0,"UserDefinedAtrributes")
End Sub
CCF-)[Calc]固有Format Range
Sub oDisplaySimilarRange
Dim oSheetUniqueRange
Dim oSheetCellRange
Dim oAddress
Dim oGetFormat
Dim oSheet
oSheet = ThisComponent.Sheets(1)
'getCellFormatRanges()
oGetFormat = oSheet.getCellFormatRanges()
oDisp = "[ getCellFormatRanges() ]" & Chr$(10)
for i= 0 to oGetFormat.getCount-1
oSheetCellRange = oGetFormat.getByIndex(i)
oAddress = oSheetCellRange.getRangeAddress()
oDisp = oDisp & Chr$(9) & Chr$(9) & _
i & " = Sheet" & (oAddress.Sheet +1) & "." & _
ColumnNumberToString(oAddress.StartColumn) & (oAddress.StartRow + 1) & _
":" & _
ColumnNumberToString(oAddress.EndColumn) & (oAddress.EndRow + 1) & _
Chr$(10)
next i
oDisp =oDisp & Chr$(10)
'
'getUniqueCellFormatRanges()
oGetFormat = oSheet.getUniqueCellFormatRanges()
oDisp = oDisp & "[ getUniqueCellFormatRanges() ]" & Chr$(10)
for i= 0 to oGetFormat.getCount-1
oSheetUniqueRange = oGetFormat.getByIndex(i)
oDisp = oDisp & Chr$(9) & Chr$(9) & _
i & " = " & oSheetUniqueRange.getRangeAddressesAsString() & _
Chr$(10)
next i
'Display
msgbox(oDisp , 0, "Like Range")
End Sub
'[ Function2 ]
Function ColumnNumberToString(ByVal nColumn As Long) as String
Dim oReturn2 as String
Do While nColumn>=0
oReturn2= Chr$(65+ (nColumn MOD 26)) & oReturn2
nColumn= nColumn / 26 -1
Loop
ColumnNumberToString = oReturn2
End Function
{{ Font }}
CCFo-)[Calc]Cell幅に合わせて改行(1)
Sub oWrapping()
Dim oDoc As Object
Dim oSheet as Object
Dim oCell as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
oCell.String = "LibreOffice / ApacheOpenOffice マクロマニュアル"
oCell.IsTextWrapped = True
msgbox "Success"
End Sub
CCFo-)[Calc]Cell幅に合わせて改行(2)
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
'
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellRangeByName("A1")
oCell.String = "LibreOffice / ApacheOpenOffice マクロマニュアル(DispatchHelper)"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "WrapText"
oProp(0).Value = true
oDispatcher.executeDispatch(oFrame, ".uno:WrapText", "", 0, oProp())
'
msgbox "Success"
End Sub
CCFo-)[Calc]文字関連の Property 一覧
Sub CellPropertyList()
Dim oDoc as Object
Dim oSheet as Object
Dim oCell as Object
Dim oTextCursor as Object
oDoc=ThisComponent
oSheet=oDoc.getSheets().getByindex(0)
oCell=oSheet.getCellByPosition(0,1)
oCell.String="水 素はH2"
' cell全体の設定
with oCell
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharPosture = com.sun.star.awt.FontSlant.ITALIC
.CharPostureAsian = com.sun.star.awt.FontSlant.OBLIQUE
.CharHeight=40 '英数字サイズは40(Cell単位での設定)
.CharHeightAsian=20 '日本語は20(Cell単位での設定)
end with
'
' Versionによっては Cell に値が無い状態で createTextCursor() を行うとCrashする
if Trim(oCell.String)="" then
oDisp = "Cellが空白です。" & Chr$(10) & "VersionによってはCrashする可能性があります。" & Chr$(10) & "処理を続けますか?"
oAns = msgbox(oDisp, 0,"Caution")
if oAns <> 6 then
Exit Sub
end if
end if
' Cellの一部の設定
oTextCursor = oCell.createTextCursor()
With oTextCursor
.gotoStart( False )
.goRight(3 , True )
.setPropertyValue( "CharContoured", true ) '中抜き効果
.setPropertyValue( "CharCrossedOut", true ) '取り消し線
.setPropertyValue("CharEmphasis",3) '強調文字 3は「・」の上付き、4は「、」の上付
.setPropertyValue("CharUnderlineColor", 2918503 ) ' 下線色 / 白抜きにしているので無意味
.setPropertyValue("CharShadowed",true) '下線を空白に適用しない
.setPropertyValue("CharUnderline",1) 'UnderLine
.setPropertyValue("CharRelief",1) '浮き出し ０はNormal 1は浮き出し効果
.setPropertyValue("CharShadowed",true) 'Shadow効果
.gotoEnd( False )
End with
msgbox "Success"
End Sub
CCFo-)[Calc]文字列の左1文字を下付文字にする
Sub CellFont()
Dim oDoc as Object
Dim oSheet as Object
Dim oCell as Object
Dim oTextCursor as Object
Dim oDisp as String
Dim oAns as Long
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,1)
oCell.String = "水素はH2"
'
' Versionによっては Cell に値が無い状態で createTextCursor() を行うとCrashする
if Trim(oCell.String)="" then
oDisp = "Cellが空白です。" & Chr$(10) & "VersionによってはCrashする可能性があります。" & Chr$(10) & "処理を続けますか?"
oAns = msgbox(oDisp, 0,"Caution")
if oAns <> 6 then
Exit Sub
end if
end if
'
oTextCursor = oCell.createTextCursor()
With oTextCursor
.gotoStart( False )
.gotoEnd( False )
.goLeft(1 , True )
.setPropertyValue( "CharEscapement", -101 ) '←下付は「-101」
.setPropertyValue( "CharEscapementHeight", 80 ) '←下付文字のサイズは80%としている。
End with
msgbox "Success"
End Sub
CCFo-)[Calc]Cell背景(1)
Sub BackColorOfCell()
Dim oDoc as Object
Dim oSheet as Object
Dim oCell as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,1)
oCell.CellBackColor = RGB(0,255,0)
msgbox("Success")
End Sub
CCFo-)[Calc]Cell背景(2)
Sub UnoCellBackColor()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oProp(0).Name = "BackgroundPattern.BackColor"
oProp(0).Value = &H00FF00
oDispatcher.executeDispatch(oFrame, ".uno:BackgroundPattern", "", 0, oProp())
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
CCFo-)[Calc]文字の角度(1)
Sub CellPropertiesSrv()
Dim oDoc as Object
Dim oSheet as Object
Dim oCell(5) as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
for i = 0 to 5
oCell(i) = oSheet.getCellByPosition(0,i)
oCell(i).String = "A"
next i
'
oCell(0).RotateAngle = 2000 '20degree
oCell(1).RotateAngle = 4000
oCell(2).RotateAngle = 6000
oCell(3).RotateAngle = 9000
oCell(4).RotateAngle = -4500
oCell(5).RotateAngle = -9000
msgbox("Success")
End Sub
CCFo-)[Calc]文字の角度(2)
Sub CellPropertiesSrv()
Dim oDoc as Object, oSheet as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oCell(5) as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
for i = 0 to 3
oCell(i) = oSheet.getCellByPosition(0,i)
oCell(i).String = "A"
next i
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
' Standard
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "AlignmentRotationMode"
oProp(0).Value = com.sun.star.table.CellVertJustify.STANDARD
oDispatcher.executeDispatch(oFrame, ".uno:AlignmentRotationMode", "", 0, oProp())
oProp(0).Name = "AlignmentRotation"
oProp(0).Value = 6000 ' 60 degree
oDispatcher.executeDispatch(oFrame, ".uno:AlignmentRotation", "", 0, oProp())
'
' Cell の上縁を基準に傾ける
oProp(0).Name = "ToPoint"
oProp(0).Value = "A2"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "AlignmentRotationMode"
oProp(0).Value = com.sun.star.table.CellVertJustify.TOP
oDispatcher.executeDispatch(oFrame, ".uno:AlignmentRotationMode", "", 0, oProp())
oProp(0).Name = "AlignmentRotation"
oProp(0).Value = 6000 ' 60 degree
oDispatcher.executeDispatch(oFrame, ".uno:AlignmentRotation", "", 0, oProp())
'
' Cell の下縁を基準に傾ける
oProp(0).Name = "ToPoint"
oProp(0).Value = "A3"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "AlignmentRotationMode"
oProp(0).Value = com.sun.star.table.CellVertJustify.BOTTOM
oDispatcher.executeDispatch(oFrame, ".uno:AlignmentRotationMode", "", 0, oProp())
oProp(0).Name = "AlignmentRotation"
oProp(0).Value = 6000 ' 60 degree
oDispatcher.executeDispatch(oFrame, ".uno:AlignmentRotation", "", 0, oProp())
msgbox("Success")
End Sub
CCFo-)[Calc]Font Weight
Sub CellFontWeight()
Dim oDoc as Object
Dim oSheet as Object
Dim oCell as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
With oCell
.String = "LibreOffice / Apache OpenOffice"
.CharWeight = com.sun.star.awt.FontWeight.BOLD
End With
msgbox("Success")
End Sub
CCFo-)[Calc]縦書き
Sub CellPropertiesSrv()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellRangeByName("A1")
oCell.String = "こんにちは。" & Chr$(10) & "LO Ver4" & Chr$(13) & _
"5月８日" & Chr$(10) & "( ８は全角 )"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
' Standard
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:TextdirectionTopToBottom", "", 0, Array())
'
msgbox("Success")
End Sub
{{ Font Effet }}
CCFe-1)[Calc]値にUnderLineを入れる
Sub CalcUnderLine()
Dim oCell as Object
oCell=ThisComponent.Sheets(0).getCellByPosition(0,0)
oCell.CharUnderline=com.sun.star.awt.FontUnderline.SINGLE '←実践
oCell.CharUnderline=com.sun.star.awt.FontUnderline.DOTTED '←点線
End Sub
CCFe-)[Calc]各種UnderLine設定
Sub CalcUnderLine()
Dim oDoc As Object
Dim oCell(18)
oDoc=ThisComponent
for i=0 to 18
oCell(i)=oDoc.Sheets(0).getCellByPosition(0,i)
oCell(i).String="No." & i & " underline in OOo Calc"
next i
oCell(0).CharUnderline = com.sun.star.awt.FontUnderline.NONE
oCell(1).CharUnderline = com.sun.star.awt.FontUnderline.SINGLE
oCell(2).CharUnderline = com.sun.star.awt.FontUnderline.DOUBLE
oCell(3).CharUnderline = com.sun.star.awt.FontUnderline.DOTTED
oCell(4).CharUnderline = com.sun.star.awt.FontUnderline.DONTKNOW
oCell(5).CharUnderline = com.sun.star.awt.FontUnderline.DASH
oCell(6).CharUnderline = com.sun.star.awt.FontUnderline.LONGDASH
oCell(7).CharUnderline = com.sun.star.awt.FontUnderline.DASHDOT
oCell(8).CharUnderline = com.sun.star.awt.FontUnderline.DASHDOTDOT
oCell(9).CharUnderline = com.sun.star.awt.FontUnderline.SMALLWAVE
oCell(10).CharUnderline = com.sun.star.awt.FontUnderline.WAVE
oCell(11).CharUnderline = com.sun.star.awt.FontUnderline.DOUBLEWAVE
oCell(12).CharUnderline = com.sun.star.awt.FontUnderline.BOLD
oCell(13).CharUnderline = com.sun.star.awt.FontUnderline.BOLDDOTTED
oCell(14).CharUnderline = com.sun.star.awt.FontUnderline.BOLDDASH
oCell(15).CharUnderline = com.sun.star.awt.FontUnderline.BOLDLONGDASH
oCell(16).CharUnderline = com.sun.star.awt.FontUnderline.BOLDDASHDOT
oCell(17).CharUnderline = com.sun.star.awt.FontUnderline.BOLDDASHDOTDOT
oCell(18).CharUnderline = com.sun.star.awt.FontUnderline.BOLDWAVE
End Sub
[ Note ] : NONE = DON'T KNOW
CCFe-)[Calc]下線色 / Color of Underline
Sub FontEffect()
Dim oDoc as Object
Dim oSheet as Object
Dim oCell as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
oCell.String = "LibreOffice"
' Font Effect
with oCell
.CharHeight = 20
.CharHeightAsian = 20
.CharUnderline = com.sun.star.awt.FontUnderline.DOUBLE
.CharUnderlineColor = RGB(255,0,0) ' Color of the Underline of Font
.CharUnderlineHasColor = true
end with
End Sub
CCFe-)[Calc]各種UnderLineと下線色
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim Dummy()
Dim oDispatcher as Object
Dim oProp(2) as new com.sun.star.beans.PropertyValue
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellRangeByName("A1")
oCell.String = "LibreOffficeです"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' 下線
oProp(0).Name = "Underline.LineStyle"
oProp(0).Value = com.sun.star.awt.FontUnderline.WAVE
oProp(1).Name = "Underline.HasColor"
oProp(1).Value = true
oProp(2).Name = "Underline.Color"
oProp(2).Value = &HFF0000 ' Red
oDispatcher.executeDispatch(oFrame, ".uno:Underline", "", 0, oProp())
End Sub
CCFe-)[Calc]影付き文字(1)
Sub FontEffect()
Dim oDoc as Object
Dim oSheet as Object
Dim oCell as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
oCell.String = "LibreOffice"
' Font Effect
with oCell
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharHeight = 20
.CharHeightAsian = 20
.CharWeight = com.sun.star.awt.FontWeight.ULTRABOLD
.CharWeightAsian = com.sun.star.awt.FontWeight.ULTRABOLD
.CharShadowed = true
end with
End Sub
CCFe-)[Calc]影付き文字(2)
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim Dummy()
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellRangeByName("A1")
oCell.String = "LibreOffficeです"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' 影付き文字
oProp(0).Name = "Shadowed"
oProp(0).Value = true
oDispatcher.executeDispatch(oFrame, ".uno:Shadowed", "", 0, oProp())
End Sub
CCFe-)[Calc]各種取消し線(1)
Sub FontEffect()
Dim oDoc as Object
Dim oSheet as Object
Dim oCell1, oCell2, oCell3, oCell4, oCell5 as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
' Font Effect
oCell1 = oSheet.getCellByPosition(0,0)
oCell1.String = "LibreOffice"
with oCell1
.CharHeight = 20
.CharHeightAsian = 20
.CharStrikeout = com.sun.star.awt.FontStrikeout.SINGLE ' 一重線
end with
'
oCell2 = oSheet.getCellByPosition(0,1)
oCell2.String = "Apache OpenOffice"
with oCell2
.CharHeight = 20
.CharHeightAsian = 20
.CharStrikeout = com.sun.star.awt.FontStrikeout.DOUBLE ' 二重線
end with
'
oCell3 = oSheet.getCellByPosition(0,2)
oCell3.String = "OpeOnffice.org"
with oCell3
.CharHeight = 20
.CharHeightAsian = 20
.CharStrikeout = com.sun.star.awt.FontStrikeout.BOLD ' 太線
end with
'
oCell4 = oSheet.getCellByPosition(0,3)
oCell4.String = "MS-Office"
with oCell4
.CharHeight = 20
.CharHeightAsian = 20
.CharStrikeout = com.sun.star.awt.FontStrikeout.SLASH ' 斜線
end with
'
oCell5 = oSheet.getCellByPosition(0,4)
oCell5.String = "NeoOffice"
with oCell5
.CharHeight = 20
.CharHeightAsian = 20
.CharStrikeout = com.sun.star.awt.FontStrikeout.X ' ×線
end with
End Sub
CCFe-)[Calc]各種取消し線(2)
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim Dummy()
Dim oDispatcher as Object
Dim oProp(2) as new com.sun.star.beans.PropertyValue
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellRangeByName("A1")
oCell.String = "LibreOffficeです"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' 下線
oProp(0).Name = "Strikeout.Kind"
oProp(0).Value = com.sun.star.awt.FontStrikeout.DOUBLE
oDispatcher.executeDispatch(oFrame, ".uno:Strikeout", "", 0, oProp())
End Sub
'
'[ Note ]
' com.sun.star.awt.FontStrikeout.SINGLE : 1
' com.sun.star.awt.FontStrikeout.DOUBLE : 2
' com.sun.star.awt.FontStrikeout.DONTKNOW : 3
' com.sun.star.awt.FontStrikeout.BOLD : 4
' com.sun.star.awt.FontStrikeout.SLASH : 5
' com.sun.star.awt.FontStrikeout.X : 6
CCFe-)[Calc]各種OverLine
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim Dummy()
Dim oDispatcher as Object
Dim oProp(2) as new com.sun.star.beans.PropertyValue
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellRangeByName("A1")
oCell.String = "LibreOffficeです"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' 下線
oProp(0).Name = "Overline.LineStyle"
oProp(0).Value = 10
oProp(1).Name = "Overline.HasColor"
oProp(1).Value = true
oProp(2).Name = "Overline.Color"
oProp(2).Value = &HFF0000 ' Red
oDispatcher.executeDispatch(oFrame, ".uno:Overline", "", 0, oProp())
End Sub
'
' [ Note ]
' 0 : NONE
' 1 : SINGLE
' 2 : DOUBLE
' 3 : DOTTED
' 4 : DONTKNOW
' 5 : DASH
' 6 : LONGDASH
' 7 : DASHDOT
' 8 : DASHDOTDOT
' 9 : SMALLWAVE
' 10 : WAVE
' 11 : DOUBLEWAVE
' 12 : BOLD
' 13 : BOLDDOTTED
' 14 : BOLDDASH
' 15 : BOLDLONGDASH
' 16 : BOLDDASHDOT
' 17 : BOLDDASHDOTDOT
' 18 : BOLDWAVE
CCFe-)[Calc]浮き出し/浮き彫り文字
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim Dummy()
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellRangeByName("A1")
oCell.String = "LibreOffficeです"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' 浮き出し
oProp(0).Name = "CharacterRelief"
oProp(0).Value = 1
oDispatcher.executeDispatch(oFrame, ".uno:CharacterRelief", "", 0, oProp())
msgbox "浮き出し文字",0,"CharacterRelief"
' 浮き彫り
oProp(0).Name = "CharacterRelief"
oProp(0).Value = 2
oDispatcher.executeDispatch(oFrame, ".uno:CharacterRelief", "", 0, oProp())
msgbox "浮き彫り文字",0,"CharacterRelief"
End Sub
CCFe-)[Calc]中抜き文字
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim Dummy()
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
'
oDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Dummy())
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellRangeByName("A1")
oCell.String = "LibreOffficeです"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' Outline Font( 中抜き文字 )
oProp(0).Name = "OutlineFont"
oProp(0).Value = true
oDispatcher.executeDispatch(oFrame, ".uno:OutlineFont", "", 0, oProp())
End Sub
CCFe-)[Calc]
{{ Position / Size }}
CCP-)[Calc]Cell内の位置設定1
Sub Main
Dim oDoc as object
Dim oSheet as Object
oDoc=ThisCmponent
oSheet=oDoc.Sheets(0)
oCell_Ran = oSheet.getCellRangeByPosition(1,3,1,200) '←範囲選択
oCell_Ran.HoriJustify = com.sun.star.table.CellHoriJustify.RIGHT '←横 右揃え
oCell_Ran.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER '←横 中央揃え
oCell_Ran.HoriJustify = com.sun.star.table.CellHoriJustify.LEFT '←横 左揃え
oCell_Ran.VertJustify = com.sun.star.table.CellVertJustify.TOP '←縦 上揃え
oCell_Ran.VertJustify = com.sun.star.table.CellVertJustify.CETER '←縦 中央揃え
oCell_Ran.VertJustify = com.sun.star.table.CellVertJustify.BOTTOM '←縦 下揃え
End Sub
CCP-)[Calc]Cell内の配置設定
sub Main
Dim oCell as Object
oCell=ThisComponent.Sheets(0).getCellByPosition(0,0)
oCell.HoriJustify=com.sun.star.table.CellHoriJustify.CENTER '←横方向をセンター
oCell.HoriJustify=com.sun.star.table.CellHoriJustify.LEFT '←横方向を左揃え
oCell.HoriJustify=com.sun.star.table.CellHoriJustify.RIGHT '←横方向を右揃え
oCell.VertJustify=com.sun.star.table.CellVertJustify.CENTER '←縦方向をセンター
oCell.VertJustify=com.sun.star.table.CellVertJustify.TOP '←縦方向を左揃え
oCell.VertJustify=com.sun.star.table.CellVertJustify.BOTTOM '←縦方向を右揃え
End Sub
CCP-)[Calc]Cell内の位置設定3
Sub CellPropertiesSrv()
Dim oDoc as Object, oSheet as Object
Dim oCell(5) as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
for i = 0 to 5
oCell(i) = oSheet.getCellByPosition(0,i)
oCell(i).Value = i*10
next i
oCell(0).HoriJustify = com.sun.star.table.CellHoriJustify.STANDARD
oCell(1).HoriJustify = com.sun.star.table.CellHoriJustify.LEFT
oCell(2).HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
oCell(3).HoriJustify = com.sun.star.table.CellHoriJustify.RIGHT
oCell(4).HoriJustify = com.sun.star.table.CellHoriJustify.BLOCK
oCell(5).HoriJustify = com.sun.star.table.CellHoriJustify.REPEAT
msgbox("Success")
End Sub
CCP-)[Calc]Cell内の位置設定4
Sub CellPropertiesSrv()
Dim oDoc as Object, oSheet as Object
Dim oCell(8) as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
for i = 0 to 8
oCell(i) = oSheet.getCellByPosition(0,i)
oCell(i).Value = i*10
if i = 4 then
oCell(i).String = CStr(oCell(i).Value) & "Test"
end if
next i
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "HorizontalJustification"
oProp(0).Value = com.sun.star.table.CellHoriJustify.STANDARD
oDispatcher.executeDispatch(oFrame, ".uno:HorizontalJustification", "", 0, oProp())
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A2"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "HorizontalJustification"
oProp(0).Value = com.sun.star.table.CellHoriJustify.LEFT
oDispatcher.executeDispatch(oFrame, ".uno:HorizontalJustification", "", 0, oProp())
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A3"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "HorizontalJustification"
oProp(0).Value = com.sun.star.table.CellHoriJustify.CENTER
oDispatcher.executeDispatch(oFrame, ".uno:HorizontalJustification", "", 0, oProp())
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A4"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "HorizontalJustification"
oProp(0).Value = com.sun.star.table.CellHoriJustify.RIGHT
oDispatcher.executeDispatch(oFrame, ".uno:HorizontalJustification", "", 0, oProp())
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A5"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "HorizontalJustification"
oProp(0).Value = com.sun.star.table.CellHoriJustify.BLOCK
oDispatcher.executeDispatch(oFrame, ".uno:HorizontalJustification", "", 0, oProp())
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A6"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "HorizontalJustification"
oProp(0).Value = com.sun.star.table.CellHoriJustify.REPEAT
oDispatcher.executeDispatch(oFrame, ".uno:HorizontalJustification", "", 0, oProp())
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A7"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "VerticalJustification"
oProp(0).Value = com.sun.star.table.CellVertJustify.TOP
oDispatcher.executeDispatch(oFrame, ".uno:VerticalJustification", "", 0, oProp())
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A8"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "VerticalJustification"
oProp(0).Value = com.sun.star.table.CellVertJustify.CENTER
oDispatcher.executeDispatch(oFrame, ".uno:VerticalJustification", "", 0, oProp())
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A9"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "VerticalJustification"
oProp(0).Value = com.sun.star.table.CellVertJustify.BOTTOM
oDispatcher.executeDispatch(oFrame, ".uno:VerticalJustification", "", 0, oProp())
'
msgbox("Success")
End Sub
CCP-)[Calc]任意のCell位置までの左からの距離
Sub CellPropertiesSrv()
Dim oSheets
Dim oCell
oSheets = ThisComponent.Sheets(1)
oCell =oSheets.getCellByPosition(1,2)
oDisp = CStr(oCell.Position.X/100) & " mm from the Left"
msgbox(oDisp,0,"com.sun.star.sheet.SheetCell Service")
End Sub
CCP-)[Calc]任意のCell位置までの上からの距離
Sub CellPropertiesService()
Dim oSheets
Dim oCell
oSheets = ThisComponent.Sheets(1)
oCell =oSheets.getCellByPosition(2,3) '← B3 cellの値を表示する場合
oDisp = CStr(oCell.Position.Y/100) & " mm from the top"
msgbox(oDisp,0,"com.sun.star.sheet.SheetCell Service")
End Sub
CCP-)[Calc]Cell Size取得
Sub CellSize()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oCellHg as Double, oCellWdh as Double
Dim oDisp As String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellByposition(1,1) ' B2
oCellWdh = oCell.Size.Width / 100
oCellHgt = oCell.Size.Height / 100
oDisp = "[ Cell Size( About ) ]" & Chr$(10) & oCell.AbsoluteName & Chr$(10) & " Width = " & _
CStr(oCellWdh) & " mm" & Chr$(10) & " Height = " & CStr(oCellHgt) & " mm"
msgbox(oDisp,0,"Cell Size")
End Sub
CCP-)[Calc]
{{ 罫線 }}
CCL-)[Calc]選択範囲に罫線を引く(1)
Sub CalcLine()
Dim oDoc as Object, oSheet as Object, oRange as Object
Dim aTableBorder as Object, aLine as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oRange = oSheet.getCellRangeByName("B2:E8")
aTableBorder = CreateUnoStruct("com.sun.star.table.TableBorder")
aLine = CreateUnoStruct("com.sun.star.table.BorderLine")
'
'ラインの内容
aLine.OuterLineWidth = 100 ' in 0.01mm
aLine.InnerLineWidth = 50 ' in 0.01mm
aLine.LineDistance = 100 ' in 0.01mm
aLine.Color = RGB(255,0,0)
'
'表用罫線外枠のライン指定
aTableBorder.TopLine = aLine
aTableBorder.BottomLine = aLine
aTableBorder.LeftLine = aLine
aTableBorder.RightLine = aLine
'表用罫線外枠のライン表示のオン
aTableBorder.IsTopLineValid = True
aTableBorder.IsBottomLineValid = True
aTableBorder.IsLeftLineValid = True
aTableBorder.IsRightLineValid = True
'表用罫線内側のライン指定
aTableBorder.HorizontalLine = aLine
aTableBorder.VerticalLine = aLine
'表用罫線内側のライン表示のオン
aTableBorder.IsHorizontalLineValid = true
aTableBorder.IsVerticalLineValid = true
'範囲に表用罫線設定反映
oRange.TableBorder = aTableBorder
'
msgbox "Success"
End Sub
'
' [ Note ]
' LibreOffice3.5系は本Codeにて描写できたが、LibreOffice4.1( Windows )では、Error無く実行するが描写はしない。
' LibreOffice4.2 API Documentには記述がある。LibreOffice / Apache OpenOffice
CCL-)[Calc]選択範囲に罫線を引く(2)
Sub CalcLine()
Dim oDoc As Object
Dim oCtrl as Object
Dim oSelRange as Object, oCellRange as Object
Dim oBorder1 as Object, oBorder2 as Object, oBorder3 as Object, oBorder4 as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oSelRange = oCtrl.getActiveSheet().getCellRangeByName( "B3:D5" )
oCtrl.select( oSelRange )
'
oCellRange = oDoc.CurrentSelection(0)
' Border1 Property
oBorder1 = CreateUnoStruct("com.sun.star.table.BorderLine2")
oBorder1.Color = RGB(255, 0, 0)
oBorder1.LineWidth = 30
oBorder1.LineStyle = 2
' Border2 Property
oBorder2 = CreateUnoStruct("com.sun.star.table.BorderLine2")
oBorder2.Color = RGB(0, 0, 255)
oBorder2.LineWidth = 10
oBorder2.LineStyle = 9
' Border3 Property
oBorder3 = CreateUnoStruct("com.sun.star.table.BorderLine2")
oBorder3.Color = RGB(0, 255, 0)
oBorder3.LineWidth = 30
oBorder3.LineStyle = 14
' Border4 Property
oBorder4 = CreateUnoStruct("com.sun.star.table.BorderLine2")
oBorder4.Color = RGB(0, 255, 255)
oBorder4.LineWidth = 30
oBorder4.LineStyle = 10
' Set Border
oCellRange.BottomBorder = oBorder1
oCellRange.TopBorder = oBorder2
oCellRange.LeftBorder = oBorder3
oCellRange.RightBorder = oBorder4
'
oSelRange = oCtrl.getActiveSheet().getCellRangeByName( "A1" )
oCtrl.select( oSelRange )
msgbox "Success"
End Sub
' [ Note ]
' Top/Bottom と Left / Rgightでは線の太さやStyleによる。太さがStyle同じ時は ?
' [ LibreOffice ]
' com.sun.star.table.BorderLine2 / com.sun.star.table.BorderLineStyle
' 上記がNetwork Errorの場合は com.sun.star.table.BorderLine2 / com.sun.star.table.BorderLineStyle
CCL-)[Calc]選択範囲に罫線を引く(3)
Sub CalcLine()
Dim oDoc As Object
Dim oCtrl as Object
Dim oSelRange as Object, oCellRange as Object
Dim oBorder1 as Object, oBorder2 as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oSelRange = oCtrl.getActiveSheet().getCellRangeByName( "B3:D5" )
oCtrl.select( oSelRange )
'
oCellRange = oDoc.CurrentSelection(0)
' Border1 Property
oBorder1 = oCellRange.LeftBorder ' oCellRange.BottomBorder / LeftBorder / RightBorder でも同じ
oBorder1.Color = RGB(255, 0, 0)
oBorder1.InnerLineWidth = 30
oBorder1.LineStyle = 1 ' 0 : Line / 1 : Dot( 点線 ) / 2 : Dash( 破線 )
' Border2 Property
oBorder2 = oCellRange.RightBorder
oBorder2.Color = RGB(0, 0, 255)
oBorder2.InnerLineWidth = 10
oBorder2.LineStyle = 2
' Set Border
oCellRange.BottomBorder = oBorder1
oCellRange.TopBorder = oBorder2
oCellRange.LeftBorder = oBorder1
oCellRange.RightBorder = oBorder2
'
oSelRange = oCtrl.getActiveSheet().getCellRangeByName( "A1" )
oCtrl.select( oSelRange )
msgbox "Success"
End Sub
'
' [ Note ]
' com.sun.star.table.BorderLine2 とは .LineWidth と .InneLineWidth が異なり、使えるLineStyleも限定される模様。
CCL-)[Calc]外枠に罫線を引く
Sub UnoCalcLine()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
Dim oProp1(7) as new com.sun.star.beans.PropertyValue
Dim oWidthPt1 as Integer, oWidthPt2 as Integer, oWidthPt3 as Integer
Dim oColor1 as Long, oColor2 as Long, oColor3 as Long
'
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "B3:C5"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oWidthPt1 = 150 ' ← 幅値の設定は？
oWidthPt2 = 80
oWidthPt3 = 10
oColor1 = CLng("&HFF0000") ' Red
oColor2 = CLng("&H00FF00") ' Green
oColor3 = CLng("&H0000FF") ' Blue
'
' 選択範囲の左に線を引く
oProp1(0).Name = "BorderOuter.LeftBorder"
oProp1(0).Value = Array(oColor1, 0, oWidthPt1, 0)
oProp1(1).Name = "BorderOuter.LeftDistance"
oProp1(1).Value = 10
' 選択範囲の右に線を引く
oProp1(2).Name = "BorderOuter.RightBorder"
oProp1(2).Value = Array(oColor2, 0, oWidthPt2, 0)
oProp1(3).Name = "BorderOuter.RightDistance"
oProp1(3).Value = 0
' 選択範囲の上に線を引く
oProp1(4).Name = "BorderOuter.TopBorder"
oProp1(4).Value = Array(oColor3, 0, oWidthPt3, 0)
oProp1(5).Name = "BorderOuter.TopDistance"
oProp1(5).Value = 0
' 選択範囲の下には線を引かない
Rem oProp1(6).Name = "BorderOuter.RightBorder"
Rem oProp1(6).Value = Array(0, 0, oWidthPt, 0)
Rem oProp1(7).Name = "BorderOuter.RightDistance"
Rem oProp1(7).Value = 0
oDispatcher.executeDispatch(oFrame, ".uno:BorderOuter", "", 0, oProp1())
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
msgbox "Success"
End Sub
'
' [ Note ]
' Apache OpenOffice / :: com :: sun :: star :: table :: / Struct BorderLine
' Array(Color, InnerLineWidth, OuterLineWidth, LineDistance)
' BorderOuterでは、InnerLineWidth / LineDistanceの設定は不可?
CCL-)[Calc]Cellに影を付ける(1)
Sub UnoCalcLine()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
Dim oProp1(3) as new com.sun.star.beans.PropertyValue
'
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "B3:C5"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oProp1(0).Name = "BorderShadow.Location"
oProp1(0).Value = com.sun.star.table.ShadowLocation.BOTTOM_LEFT
oProp1(1).Name = "BorderShadow.Width"
oProp1(1).Value = 200 ' Cellの端からの間隔 : unit 1/100 mm
oProp1(2).Name = "BorderShadow.IsTransparent"
oProp1(2).Value = false
oProp1(3).Name = "BorderShadow.Color"
oProp1(3).Value = RGB( 0, 255, 0 )
oDispatcher.executeDispatch(oFrame, ".uno:BorderShadow", "", 0, oProp1())
'
msgbox "Success"
End Sub
'
' [ Note ]
' enum com.sun.star.table.ShadowLocation
' LibreOffice / Apache openOffice
CCL-)[Calc]Cellに影を付ける(2)
Sub CellShadow()
Dim oDoc as Object, oSheet as Object, oCell As Object
Dim oShadow As New com.sun.star.table.ShadowFormat
oDoc = ThisComponent
oSheet = oDoc.getSheets.getByIndex(0)
oCell = oSheet.getCellRangeByName( "B2:C4" )
' CellのBackColor
' oCell.CellBackColor = RGB( 255, 128, 128 )
'
oShadow.Color = RGB( 0, 0, 255 ) ' Shadow color
oShadow.Location = com.sun.star.table.ShadowLocation.TOP_RIGHT
oShadow.IsTransparent = False
oShadow.ShadowWidth = 250 ' 1/100 mm
oCell.ShadowFormat = oShadow
'
msgbox "Success"
End Sub
'
' [ Note ]
' com.sun.star.table.ShadowFormat
' LibreOffice / Apache OpenOffice
CCL-)[Calc]
{{ Protection }}
CCPct-)[Calc]保護する＆ 数式を表示しない(1)
Sub CellProtect()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
Dim oProp2(1) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
' 直接設定した書式の解除
oDispatcher.executeDispatch(oFrame, ".uno:ResetAttributes", "", 0, Array())
' Cellの保護Tab/保護する
oProp2(0).Name = "Protection.Locked"
oProp2(0).Value = false ' true : Check ON / false : Check Off
' 数式を表示しない
oProp2(1).Name = "Protection.FormulasHidden"
oProp2(1).Value = true
oDispatcher.executeDispatch(oFrame, ".uno:Protection", "", 0, oProp2())
'
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
CCPct-)[Calc]保護する＆ 数式を表示しない(2)
Sub CellProtect()
Dim oDoc as Object, oSheet as Object, oRange as Object
Dim oUnoCellPrct as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oRange = oSheet.getCellRangeByName("A1:C3")
'
' Defalt setting for protection of cell
oRange.setPropertyToDefault("CellProtection")
'
oUnoCellPrct = createUnoStruct("com.sun.star.util.CellProtection")
With oUnoCellPrct
.IsFormulaHidden = true
.IsLocked = true
End With
oRange.setPropertyValue( "CellProtection", oUnoCellPrct )
msgbox "Success"
End Sub
CCPct-)[Calc]すべて表示しない(1)
Sub CellProtect()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
Dim oProp2(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' 直接設定した書式の解除
oDispatcher.executeDispatch(oFrame, ".uno:ResetAttributes", "", 0, Array())
' すべて表示しない
oProp2(0).Name = "Protection.Hidden"
oProp2(0).Value = true ' true : Check ON / false : Check Off
oDispatcher.executeDispatch(oFrame, ".uno:Protection", "", 0, oProp2())
'
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
CCPct-)[Calc]すべて表示しない(2)
Sub CellProtect()
Dim oDoc as Object, oSheet as Object, oRange as Object
Dim oUnoCellPrct as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oRange = oSheet.getCellRangeByName("A1:C3")
'
' Defalt setting for protection of cell
oRange.setPropertyToDefault("CellProtection")
'
oUnoCellPrct = createUnoStruct("com.sun.star.util.CellProtection")
With oUnoCellPrct
.IsHidden = true
End With
oRange.setPropertyValue( "CellProtection", oUnoCellPrct )
msgbox "Success"
End Sub
CCPct-)[Calc]印刷しない(1)
Sub CellProtect()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
Dim oProp2(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' 直接設定した書式の解除
oDispatcher.executeDispatch(oFrame, ".uno:ResetAttributes", "", 0, Array())
' 印刷しない
oProp2(0).Name = "Protection.HiddenInPrintout"
oProp2(0).Value = true
oDispatcher.executeDispatch(oFrame, ".uno:Protection", "", 0, oProp2())
'
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
CCPct-)[Calc]印刷しない(2)
Sub CellProtect()
Dim oDoc as Object, oSheet as Object, oRange as Object
Dim oUnoCellPrct as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oRange = oSheet.getCellRangeByName("A1:C3")
'
' Defalt setting for protection of cell
oRange.setPropertyToDefault("CellProtection")
'
oUnoCellPrct = createUnoStruct("com.sun.star.util.CellProtection")
With oUnoCellPrct
.IsPrintHidden = true
End With
oRange.setPropertyValue( "CellProtection", oUnoCellPrct )
msgbox "Success"
End Sub
CCPct-)[Calc]Cellの保護をDefaultに設定
Sub CellProtect()
Dim oDoc as Object, oSheet as Object, oRange as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oRange = oSheet.getCellRangeByName("A1")
'
oRange.setPropertyToDefault("CellProtection")
msgbox "Success"
End Sub
{{ Color }}
CCCo-)[Calc]文字Color
Sub CalcCharColor()
Dim oDoc as Object, oSheet as Object
Dim oCell(1) as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
for i = 0 to 1
oCell(i) = oSheet.getCellByPosition(0,i)
select case i
case 0
with oCell(i)
.String = "LibreOffice"
.charColor = RGB(0,0,255)
.IsTextWrapped = false
end with
case 1
with oCell(i)
.String = "Apache OpenOffice"
.charColor = RGB(0,255,0)
.IsTextWrapped = true
end with
end select
next i
msgbox "Success",0,"CharColor"
End Sub
CCCo-)[Calc]文字列の金額部分（右部分)のみを赤色にする
Sub CalcCharColor()
Dim oDoc as Object, oSheet as Object
Dim oCell as Object
Dim oTextCursor as Object
oDoc=ThisComponent
oSheet=oDoc.getSheets().getByName("sheet1")
oCell=oSheet.getCellByPosition(0,0)
oCell.String="1,000円（2009/8/16)"
oTextCursor = oCell.createTextCursor()
oCNum= InStr(1,oCell.String,"円") '「円」までの文字数を調べる。
With oTextCursor
.gotoStart( False )
.goRight( oCNum, True )
.setPropertyValue( "CharColor", RGB(255,0,0) )
.gotoEnd( False )
End With
msgbox "Success"
End Sub
{{ autoFormat }}
CCAF-)[Calc]autoFormat
Sub oCalcAutoFormat
Dim oDoc as Object
Dim oSheet as Object
Dim oCellrange as Object
Dim oAutoFormat as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCellRange = oSheet.getCellRangeByPosition(0, 0, 5, 5)
oCellRange.autoFormat("3D")
'
msgbox "Success"
End Sub
'
' [ Format Name ]
' FormatNameは以下の様な値があるが、3D以外は設定されない。
' 3D
' Black 1
' Black 2
' Blue
' Brown
' Currency
' Currency 3D
' Currency Lavender
' Currency Turquoise
' Gray
' Green
' 参考uRL : http://wiki.services.openoffice.org/wiki/Documentation/OOo3_User_Guides/Calc_Guide/Autoformat_and_themes
CCAF-)[Calc]
{{ Annotation( Comment ) }}
CCCmt-)[Calc]CellのComment取得
Sub CalcAnnotation()
Dim oDoc as Object
Dim oSheet as Object
Dim oCell as Object
Dim oCmt as Object
Dim oCmtStr as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
oCmt = oCell.getAnnotation()
oCmtStr = oCmt.getString
msgbox(oCmtStr, 0, "CellのComment取得")
End Sub
CCCmt-)[Calc]CellへのComment挿入
Sub CalcAnnotation()
Dim oDoc as Object
Dim oSheet as Object
Dim oCell as Object
Dim oCmt as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
' Annotation Object 作成
oCmt = oCell.getAnnotation()
' 新規Commentの挿入
oSheet.getAnnotations().insertNew(oCell.getCellAddress(), "Commentの挿入")
' Commentの表示
oCmt.setIsVisible( True )
'
msgbox "Success"
End Sub
CCCmt-)[Calc]CellのCommentを削除(1)
Sub CalcAnnotation()
Dim oDoc as Object
Dim document as object
Dim dispatcher as object
Dim oArg(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
document = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
' B2 Cell へ移動
oArg(0).Name = "ToPoint"
oArg(0).Value = "$B$2"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, oArg())
'
' Comment 削除
dispatcher.executeDispatch(document, ".uno:DeleteNote", "", 0, Array())
msgbox "Success"
End Sub
CCCmt-)[Calc]CellのCommentを削除(2)
Sub CalcAnnotation()
Dim oDoc as Object
Dim oSheet as Object
Dim oCell as Object, oCellRange as Object
Dim oCmt as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
' Annotation Object 作成
oCmt = oCell.getAnnotation()
' 新規Commentの挿入
oSheet.getAnnotations().insertNew(oCell.getCellAddress(), "Commentの挿入")
' Commentの表示
oCmt.setIsVisible( true )
msgbox "Comment表示", 0, "Comment"
'
' Commentを非表示にしないと表示が消えない
oCmt.setIsVisible( false )
oCellRange = oSheet.getCellRangeByName("A1")
oCellRange.clearContents(com.sun.star.sheet.CellFlags.ANNOTATION)
msgbox "Commentの削除", 0, "Comment"
End Sub
CCCmt-)[Calc]Comment設定数取得
Sub CalcAnnotation()
Dim oDoc as Object, oSheet as Object
Dim oCell(2) as Object
Dim oShtName as String
Dim oBfrCnt as Long, oAftCnt as Long
Dim oCmtStr as String
Dim oCmt as Object
Dim oDisp as String
oDoc = ThisComponent
oShtName = "sheet1"
oSheet = oDoc.getSheets().getByName(oShtName)
' Before
oBfrCnt = oSheet.annotations.count
oDisp = oShtName & "における" & Chr$(10) & _
"Annotation数 = " & oBfrCnt & "( Before )"
'
for i = 0 to 2
oCell(i) = oSheet.getCellByPosition(0, 3 + 3*i )
oCmtStr = "Commnet" & i
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt = oCell(i).getAnnotation()
oCmt.setIsVisible( True )
next i
' After
oAftCnt = oSheet.annotations.count
oDisp = oDisp & Chr$(10) & "Annotation数 = " & oAftCnt & "( After )"
msgbox oDisp,0,"Annotation"
End Sub
CCCmt-)[Calc]Fill Collor設定
Sub CalcAnnotation()
Dim oDoc as Object, oSheet as Object
Dim oCell(2) as Object
Dim oShtName as String
Dim oCmtStr as String
Dim oCmt as Object
Dim oAntShape as Object
Dim oDisp as String
oDoc = ThisComponent
oShtName = "sheet1"
oSheet = oDoc.getSheets().getByName(oShtName)
'
for i = 0 to 2
oCell(i) = oSheet.getCellByPosition(0, 3 + 3*i )
oCmtStr = "Commnet" & i
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt = oCell(i).getAnnotation()
oCmt.setIsVisible( True )
' Properties
oAntShape = oCmt.annotationShape
select case i
case 0
oAntShape.fillColor = RGB(255,255,0)
case 1
oAntShape.fillColor = RGB(0,255,255)
case 2
oAntShape.fillColor = RGB(255,0,255)
end select
next i
'
oDisp = "Success"
msgbox oDisp,0,"Annotation"
End Sub
CCCmt-)[Calc]文字Color設定
Sub CalcAnnotation()
Dim oDoc as Object, oSheet as Object
Dim oCell(2) as Object
Dim oShtName as String
Dim oCmtStr as String
Dim oCmt as Object
Dim oAntShape as Object
Dim oDisp as String
oDoc = ThisComponent
oShtName = "sheet1"
oSheet = oDoc.getSheets().getByName(oShtName)
'
for i = 0 to 2
oCell(i) = oSheet.getCellByPosition(0, 3 + 3*i )
oCmtStr = "Commnet" & i
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt = oCell(i).getAnnotation()
oCmt.setIsVisible( True )
' Properties
oAntShape = oCmt.annotationShape
select case i
case 0
oAntShape.CharColor = RGB(255,123,0)
case 1
oAntShape.CharColor = RGB(0,255,123)
case 2
oAntShape.CharColor = RGB(123,0,255)
end select
next i
'
oDisp = "Success"
msgbox oDisp,0,"Annotation"
End Sub
CCCmt-)[Calc]文字Font( FontName / Posture / Hieght )設定
Sub CalcAnnotation()
Dim oDoc as Object, oSheet as Object
Dim oCell(2) as Object
Dim oShtName as String
Dim oCmtStr as String
Dim oCmt as Object
Dim oAntShape as Object
Dim oDisp as String
oDoc = ThisComponent
oShtName = "sheet1"
oSheet = oDoc.getSheets().getByName(oShtName)
'
for i = 0 to 2
oCell(i) = oSheet.getCellByPosition(0, 3 + 4*i )
oCmtStr = "Commentの設定" & i
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt = oCell(i).getAnnotation()
oCmt.setIsVisible( True )
' Properties
oAntShape = oCmt.annotationShape
select case i
case 0
with oAntShape
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharPosture = com.sun.star.awt.FontSlant.ITALIC
.CharPostureAsian = com.sun.star.awt.FontSlant.OBLIQUE
.CharHeight=12
.CharHeightAsian=16
end with
case 1
with oAntShape
.CharFontName = "MS Gothic"
.CharFontNameAsian = "MS UI Gothic"
.CharPosture = com.sun.star.awt.FontSlant.REVERSE_OBLIQUE
.CharPostureAsian = com.sun.star.awt.FontSlant.REVERSE_ITALIC
.CharHeight=16
.CharHeightAsian=10
end with
case 2
with oAntShape
.CharFontName = "Century"
.CharFontNameAsian = "MS Gothic"
.CharPosture = com.sun.star.awt.FontSlant.NONE
.CharPostureAsian = com.sun.star.awt.FontSlant.ITALIC
.CharHeight=14
.CharHeightAsian=14
end with
end select
next i
'
oDisp = "Success"
msgbox oDisp,0,"Annotation"
End Sub
CCCmt-)[Calc]Comment ObjectからCell Object取得
Sub CalcAnnotation()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oCmt as Object, oPntCmt as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
oCell.String = "A1 Cellの値"
oCmt = oCell.getAnnotation()
oPntCmt = oCmt.getParent()
msgbox(oPntCmt.String, 0, "Comment Cellの文字")
End Sub
CCCmt-)[Calc]Commnetの最終更新者と更新日取得
Sub CalcAnnotation()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oCmt as Object
Dim oDate as String, oAuth as String
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
' Annotation Object 作成
oCmt = oCell.getAnnotation()
' 新規Commentの挿入
oSheet.getAnnotations().insertNew(oCell.getCellAddress(), "Commentの更新")
' Commnet最終更新者と日付取得
oAuth = oCmt.getAuthor()
oDate = oCmt.getDate()
oDisp = "Commnet更新者 ⇒ " & oAuth & Chr$(10) & "Commnet更新日 ⇒ " & oDate
msgbox oDisp, 0, "Commnet"
End Sub
CCCmt-)[Calc]Commnet ObjectのAddress取得
Sub CalcAnnotation()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oCmt as Object, oCmtAddr as Object
Dim oCol as Long, oRow as Long
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(2,5)
' Annotation Object 作成
oCmt = oCell.getAnnotation()
' com:.sun.star.table.CellAddress
CmtAddr = oCmt.getPosition()
oCol = CmtAddr.Column
oRow = CmtAddr.Row
'
oDisp = "Address of Commnet Object" & Chr$(10) & " ⇒ (" & oCol & ", " & oRow & ")"
msgbox oDisp, 0, "Commnet"
End Sub
CCCmt-)[Calc]
[ 内容の削除 ]
CCC-)[Calc]選択範囲のClaer(1)
Sub CalcContentsClear()
Dim Flags as Long
Dim oDoc as Object
Dim oSheet as Object
oDoc=ThisComponent
oSheet=oDoc.sheets(0)
oCellRange=oSheet.getCellRangeByPosition(0,0,3,3) '←A1～D4の範囲
Flags=com.sun.star.sheet.CellFlags.STRING + com.sun.star.sheet.CellFlags.VALUE + com.sun.star.sheet.CellFlags.FORMULA
oCellRange.clearContents(Flags)
End Sub
'
' [ Note ]
' VALUE : selects constant numeric values that are not formatted as dates or times.
' DATETIME : selects constant numeric values that have a date or time number format.
' STRING : selects constant strings.
' ANNOTATION : selects cell annotations.
' FORMULA : selects formulas.
' HARDATTR : selects all explicit formatting, but not the formatting which is applied implicitly through style sheets.
' STYLES : selects cell styles.
' OBJECTS : selects drawing objects.
' EDITATTR : selects formatting within parts of the cell contents.
' FORMATTED : selects cells with formatting within the cells or cells with more than one paragraph within the cells.
CCC-)[Calc]選択範囲のClaer(2)
Sub CalcContentsClear()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp1(0) as new com.sun.star.beans.PropertyValue
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc=ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oProp1(0).Name = "ToPoint"
oProp1(0).Value = "A1:B6"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
oProp(0).Name = "Flags"
oProp(0).Value = "SNDFT"
oDispatcher.executeDispatch(oFrame, ".uno:Delete", "", 0, oProp())
msgbox "Success"
End Sub
'
' [ Flag Value ]
' S : String ( テキスト )
' V : Value ( 値 )
' D : Date ( 日付 )
' F : Formula ( 式 )
' N : Note ( コメント ) ' ← Comentを表示のままでは、表示が消えない( ver4.0.1.2 )
' T : Format ( 書式 )
' 空白 : Object ( オブジェクト )
' A : 全て
CCC-)[Calc]指定範囲の内容を全てClear
Sub subClearWrksheet(i as integer,sRange as string)
Dim oRange as object
oRange = ThisComponent.getSheets().getByIndex(i).getCellRangeByName(sRange)
oRange.clearContents(511)
End Sub
CCC-)[Calc]
[ Selection ]
CCSel-)[Calc]CellのSelection(1)
Sub CellSelection()
Dim oDoc as Object, oCtrl as Object
Dim oSelRange as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oSelRange = oCtrl.getActiveSheet().getCellRangeByName( "A1" )
oCtrl.select( oSelRange )
'
msgbox "Success"
End Sub
'
' [ Note ]
' .select後、Curosrを別Cellに移動させても、A1がselectされたままになるので、selectが不要になれば選択解除を行うこと。
CCSel-)[Calc]CellのSelection(2)
Sub CellSelection()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
CCSel-)[Calc]ColumnのSelection(1)
Sub ColSelection()
Dim oDoc as Object, oCtrl as Object
Dim oSheet as Object
Dim oSelRange as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oSheet = oDoc.getSheets().getByName("sheet1")
oSelRange = oSheet.getColumns().getByIndex(1) ' B Column
oCtrl.select( oSelRange )
'
msgbox "Success"
End Sub
'
' [ Note ]
' .select後、Curosrを別Cellに移動させても、B列がselectされたままになるので、selectが不要になれば選択解除を行うこと。
CCSel-)[Calc]ColumnのSelection(2)
Sub ColSelection()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "B:B" ' B Column
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
CCSel-)[Calc]ColumnのSelection(3)
Sub ColSelection()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "B2" ' B1 Cell
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:SelectColumn", "", 0, Array())
'
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
CCSel-)[Calc]RowのSelection(1)
Sub RowSelection()
Dim oDoc as Object, oCtrl as Object
Dim oSheet as Object
Dim oSelRange as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oSheet = oDoc.getSheets().getByName("sheet1")
oSelRange = oSheet.getRows().getByIndex(1) ' No.2 Row
oCtrl.select( oSelRange )
'
msgbox "Success"
End Sub
'
' [ Note ]
' .select後、Curosrを別Cellに移動させても、2行目がselectされたままになるので、selectが不要になれば選択解除を行うこと。
CCSel-)[Calc]RowのSelection(2)
Sub RowSelection()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "3:3" ' No.3 Row
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
CCSel-)[Calc]RowのSelection(3)
Sub RowSelection()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1" ' A1 Cell
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:SelectRow", "", 0, Array())
'
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
CCSel-)[Calc]Selection解除(1)
Sub DeSelection()
Dim oDoc as Object, oCtrl as Object
Dim oUtilUrl as Object
Dim oUrlTrans as Object
Dim oDeSel as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oUtilUrl = CreateUnoStruct("com.sun.star.util.URL")
oUtilUrl.Complete = ".uno:Deselect"
oUrlTrans = CreateUnoService("com.sun.star.util.URLTransformer")
oUrlTrans.parseStrict(oUtilUrl)
oDeSel = oCtrl.queryDispatch(oUtilUrl, "_self", 0)
oDeSel.dispatch(oUtilUrl, Array()
msgbox "Success"
End Sub
CCSel-)[Calc]Selection解除(2)
Sub DeSelection()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oDispatcher.executeDispatch(oFrame, ".uno:Deselect", "", 0, oProp())
'
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
'
' [ Note ]
' 本Codeを slot 値を用いて記すと Selection解除(1) になる
CCSel-)[Calc]選択Cellの選択状態を調べる
Sub oCalcIsAnythingSelected()
Dim oDoc as Object
Dim oSelection as object
Dim oImpName as String, oString as String
Dim oCount as Integer
Dim oDisp as String
oDoc = ThisComponent
oSelection = oDoc.getCurrentSelection()
'
oDisp = "[ Current Select in Calc ]" & Chr$(10)
If oSelection.supportsService("com.sun.star.sheet.SheetCell") then
oImpName = oSelection.getImplementationName()
oString = oSelection.getString()
oDisp = oDisp & "One Cell Selected : " & oImpName & Chr$(10) & _
"Strimg : " & oString & Chr$(10)
Else
If oSelection.supportsService("com.sun.star.sheet.SheetCellRange") then
oImpName = oSelection.getImplementationName()
oDisp = oDisp & "One Cell Range Selected : " & oImpName & Chr$(10)
Else
If oSelection.supportsService("com.sun.star.sheet.SheetCellRanges") then ' SheetCellRanges : 複数
oImpName = oSelection.getImplementationName()
oCount = oSelection.getCount()
oDisp = oDisp & "Multiple Cell Range Selected : " & oImpName & Chr$(10) & _
"Count : " & oCount & Chr$(10)
Else
oImpName = oSelection.getImplementationName()
oDisp = oDisp & "Something else Selected : " & oImpName & Chr$(10)
End If
End If
End If
msgbox(oDisp,0,"Is Calc anything select? ")
End Sub
CCSel-)[Calc]選択Cell全てに文字列を入力
Sub oSetSlectedCell()
Dim oStr
Dim oSelections
DIm oCell
Dim oRanges
oStr = "Current Controll"
oSelections = ThisComponent.getCurrentSelection()
If IsNull(oSelections) Then Exit Sub
'
If oSelections.supportsService( "com.sun.star.sheet.SheetCell") then
oCell = oSelections
oCell.setString(oStr)
ElseIf oSelections.supportsService( "com.sun.star.sheet.SheetCellRange") then
SetRangeText(oSelections, oStr)
ElseIf oSelections.supportsService( "com.sun.star.sheet.SheetCellRanges") then
oRanges = oSelections
for i = 0 to oRange.getCount()-1
setRangeText(oRanges.getByIndex(i), oStr)
next i
Else
oImpName = oSelections.getImplementationName()
print oImpName
End If
End Sub
'[ Function1 ]
Function setRangeText(oRange, s as String)
Dim nCol as Long
Dim nROw as Long
Dim oCols
Dim oRows
oCols = oRange.Columns
oRows = oRange.Rows
for nCol = 0 to oCols.getCount()-1
for nRow = 0 to oRows.getCount()-1
oRange.getCellByPosition(nCol,nRow).setString(s)
next nRow
next nCol
End Function
CCSel-)[Calc]
[ Address ]
CCA-)[Calc]Current CellのAddress取得(1)
Sub AddressOfCell()
Dim oDoc as Object
Dim oSel as Object
Dim oActCol as Long, oActRow as Long
Dim oShtNo as Integer
oDoc = ThisComponent
oSel = oDoc.CurrentController.getSelection()
oActCol = oSel.getRangeAddress().StartColumn
oActRow = oSel.getRangeAddress().StartRow
oShtNo = oSel.getRangeAddress().Sheet
'
oDisp = "[ Current Cell ]" & Chr$(10) & "Sheet No. =" & oShtNo & Chr$(10) & "Address = ( " & oActCol & " , " & oActRow & " )"
msgbox(oDisp,0,"Address of Cell")
End Sub
CCA-)[Calc]Current CellのAddress取得(2)
Sub AddressOfCell()
Dim oDoc as Object
Dim oSel as Object
Dim oCellAddr as Object
Dim oActCol as Long, oActRow as Long
Dim oShtNo as Integer
oDoc = ThisComponent
oSel = oDoc.CurrentController.getSelection()
oCellAddr = oSel.getCellAddress()
oActCol = oCellAddr.Column
oActRow = oCellAddr.Row
oShtNo = oCellAddr.Sheet
'
oDisp = "[ Current Cell ]" & Chr$(10) & "Sheet No. = " & oShtNo & CHr$(10) & "Address = ( " & oActCol & " , " & oActRow & " )"
msgbox(oDisp,0,"Address of Cell")
End Sub
'
' [ Note ]
' Current selection が Areaの場合、Error になる。
CCA-)[Calc]名前で指定したCellのAddress取得
Sub AddressOfCell()
Dim oDoc as Object
Dim oSheet as Object
Dim oCellRange as Object
Dim oCol as Long, oRow as Long
Dim oShtNo as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCellRange = oSheet.getCellRangeByName("B3_Sheet1") ' OOo3.0 では getCellByName() method があったが 3.4 以降は使用不可
'
' oCellRange がAreaの場合は不可 / getCellRangeAddress 使用
oCol = oCellRange.getCellAddress.Column
oRow = oCellRange.getCellAddress.Row
oShtNo = oCellRange.getCellAddress.Sheet
'
oDisp = "[ Address of Cell ]" & Chr$(10) & "Sheet No = " & oShtNo & Chr$(10) & _
"Address = ( " & oCol & " , " & oRow & " )"
msgbox(oDisp,0,"Address of Cell")
End Sub
CCA-)[Calc]Current Cellの絶対Address取得(1)
Sub oRetrieveTheActiveCell
Dim oDoc as Object
Dim oldSelection as Object
Dim oRange as Object
Dim oActiveCell as Object
Dim oConv as Object
oDoc = ThisComponent
oldSelection = oDoc.CurrentSelection
oRange = oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
oDoc.CurrentController.Select(oRange)
' Get the active cell
oActiveCell = oDoc.CurrentSelection
oConv = oDoc.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = oActiveCell.getCellAddress
oUI = oConv.UserInterfaceRepresentation
oPS = oConv.PersistentRepresentation
oDisp = "[ UserInterfaceRepresentation ]" & CHr$(10) & Chr$(9) & oUI & Chr$(10) & Chr$(10)
oDisp = oDisp & "[ PersistentRepresentation ]" & CHr$(10) & Chr$(9) & oPS & Chr$(10)
msgbox(oDisp, 0, "Representation")
oDoc.CurrentController.Select(oldSelection)
End Sub
CCA-)[Calc]Current Cellの絶対Address取得(2)
Sub ActiveCellName()
Dim oDoc as Object
Dim oActiveCell as Object
Dim oAbsName as String
oDoc = ThisComponent
oActiveCell = oDoc.CurrentSelection
oAbsName = oActiveCell.AbsoluteName
oDisp = "[ AbsoluteName ]" & Chr$(10) & oAbsName
msgbox(oDisp, 0, "Current Cell")
End Sub
CCA-)[Calc]選択範囲の最初と最後の行と列番号を取得
Sub Main
Dim oCell As Object
oCell = ThisComponent.CurrentController.getSelection()
With oCell.RangeAddress
MsgBox "Sheet: " & .Sheet & Chr(10) & _
"StartColumn: " & .StartColumn & Chr(10) & _
"StartRow:" & .StartRow & Chr(10) & _
"EndColumn: " & .EndColumn & Chr(10) & _
"EndRow: " & .EndRow
End With
End Sub
CCA-)[Calc]最終行の取得
Sub CellAddress()
Dim oDoc as Object
Dim oSheet as Object
Dim oCursor as Object
Dim oCntrl as Object
Dim oFrame as Object
Dim oDispatcher as Object
Dim oProp(1) as new com.sun.star.beans.PropertyValue
Dim oShtEndRow as Long
Dim oEndRow as Long
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCursor = oSheet.createCursor()
oShtEndRow = oCursor.getRangeAddress().EndRow
'
oCntrl = oDoc.getCurrentController()
oFrame = oCntrl.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "$A$" & oShtEndRow
oProp(1).Name = "Sel"
oProp(1).Value = false
oDispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, oProp())
'
oProp(0).Name = "By"
oProp(0).Value = 1
oProp(1).Name = "Sel"
oProp(1).Value = false
oDispatcher.executeDispatch( oFrame, ".uno:GoUpToStartOfData", "", 0, oProp())
oEndRow = oCntrl.getSelection().getRangeAddress().EndRow
'
oDisp = "[ Address of End Row ]" & Chr$(10) & "End Row = " & oEndRow
' Display
msgbox(oDisp,0,"最終行取得")
End Sub
CCA-)[Calc]列番号を数字から英字へ変換
Sub oColumnNumberToString
Dim oColumnString(5)
Dim nColumn(5) As Long
nColumn(0) = 0
nColumn(1) = 5
nColumn(2) = 10
nColumn(3) = 15
nColumn(4) = 20
nColumn(5) = 25
for i= 0 to UBound(nColumn)
oColumnString(i) = Chr$(65+ (nColumn(i) MOD 26))
oDisp = oDisp & nColumn(i) & " => " & oColumnString(i) & Chr$(10)
next i
msgbox(oDisp ,0, "Column No => String")
End Sub
CCA-)[Calc]列番号を数字から英字へ変換(2)
Function ColumnName ( ByVal ColumnNo As Long ) As String
If ColumnNo / 26 > 1 then
ColumnName = Chr ( 65 + int( ColumnNo / 26 ) - 1 ) & Chr( 65 + ColumnNo MOD 26 )
Else
ColumnName = Chr ( 65 + ColumnNo MOD 26 )
End If
End Function
CCA-)[Calc]Cell Addressの変換/(0,0)→A1
Sub CellAddrConv()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oConv as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oConv = oDoc.createInstance("com.sun.star.table.CellAddressConversion")
oCell = oSheet.getCellByPosition(0,0) ' Sheet1 / Cell A1
oConv.Address = oCell.getCellAddress()
oDisp = "Sheet1.(0,0) → " & oConv.PersistentRepresentation
msgbox(oDisp,0,"Conversion")
End Sub
CCA-)[Calc]Data Areaの最初と最後のCell Address取得
Sub StartEndRowNo()
Dim oDoc as Object
Dim oSheet as Object
Dim oFirstCell as Object
Dim oCursor as Object
Dim oFristRow as Long, oFirstCol as Long
Dim oStartRow as Long, oEndRow as Long
Dim oStartCol as Long, oEndCol as Long
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
oFirstCol = 2
oFristRow = 0
oDisp = "[ Case1 ]" & Chr$(10) & "First Cell = ( " & oFirstCol & " , " & oFristRow & " )[ C1 ]" & Chr$(10)
'
oFirstCell = oSheet.getCellByPosition(oFirstCol, oFristRow) ' C1 Cell
if oFirstCell.getType() = com.sun.star.table.CellContentType.EMPTY then
oDisp = oDisp & "First Rowが空白です。"
else
oCursor = oSheet.createCursorByRange(oFirstCell)
oCursor.gotoStart() ' Dataの始まりへ
oStartCol = oCursor.getRangeAddress.StartColumn ' １つしかCellを選択していないので、 .EndColumn でも同じ
oStartRow = oCursor.getRangeAddress.EndRow ' １つしかCellを選択していないので、 .StartRow でも同じ
oCursor.gotoEnd() ' Dataの最後へ
oEndCol = oCursor.getRangeAddress.StartColumn ' １つしかCellを選択していないので、 .StartColumn でも同じ
oEndRow = oCursor.getRangeAddress.EndRow ' １つしかCellを選択していないので、 .EndColumn でも同じ
oDisp = oDisp & "Column : " & oStartCol & " ～ " & oEndCol & Chr$(10) & _
"Row : " & oStartRow & " ～ " & oEndRow
end if
'
oFirstCol = 2
oFristRow = 4
oDisp = oDisp & Chr$(10) & Chr$(10) & "[ Case2 ]" & Chr$(10) & "First Cell = ( " & oFirstCol & " , " & oFristRow & " )[ C5 ]" & Chr$(10)
'
oFirstCell = oSheet.getCellByPosition(oFirstCol, oFristRow) ' C5 Cell
if oFirstCell.getType() = com.sun.star.table.CellContentType.EMPTY then
oDisp = oDisp & "First Rowが空白です。"
else
oCursor = oSheet.createCursorByRange(oFirstCell)
oCursor.gotoStart() ' Dataの始まりへ
oStartCol = oCursor.getRangeAddress.StartColumn ' １つしかCellを選択していないので、 .EndColumn でも同じ
oStartRow = oCursor.getRangeAddress.EndRow ' １つしかCellを選択していないので、 .StartRow でも同じ
oCursor.gotoEnd() ' Dataの最後へ
oEndCol = oCursor.getRangeAddress.StartColumn ' １つしかCellを選択していないので、 .StartColumn でも同じ
oEndRow = oCursor.getRangeAddress.EndRow ' １つしかCellを選択していないので、 .EndColumn でも同じ
oDisp = oDisp & "Column : " & oStartCol & " ～ " & oEndCol & Chr$(10) & _
"Row : " & oStartRow & " ～ " & oEndRow
end if
'
oFirstCol = 2
oFristRow = 8
oDisp = oDisp & Chr$(10) & Chr$(10) & "[ Case3 ]" & Chr$(10) & "First Cell = ( " & oFirstCol & " , " & oFristRow & " )[ C9 ]" & Chr$(10)
'
oFirstCell = oSheet.getCellByPosition(oFirstCol, oFristRow) ' C5 Cell
if oFirstCell.getType() = com.sun.star.table.CellContentType.EMPTY then
oDisp = oDisp & "First Rowが空白です。"
else
oCursor = oSheet.createCursorByRange(oFirstCell)
oCursor.gotoStart() ' Dataの始まりへ
oStartCol = oCursor.getRangeAddress.StartColumn ' １つしかCellを選択していないので、 .EndColumn でも同じ
oStartRow = oCursor.getRangeAddress.EndRow ' １つしかCellを選択していないので、 .StartRow でも同じ
oCursor.gotoEnd() ' Dataの最後へ
oEndCol = oCursor.getRangeAddress.StartColumn ' １つしかCellを選択していないので、 .StartColumn でも同じ
oEndRow = oCursor.getRangeAddress.EndRow ' １つしかCellを選択していないので、 .EndColumn でも同じ
oDisp = oDisp & "Column : " & oStartCol & " ～ " & oEndCol & Chr$(10) & _
"Row : " & oStartRow & " ～ " & oEndRow
end if
'
msgbox(oDisp,0,"最初と最後のAddress取得")
End Sub
'
' Refer to " Sheet操作/ Sheet Cursors / Simple Cursor Movement(1) "
CCA-)[Calc]Sheetの最初と最後のCell Address取得
Sub CellAddress()
Dim oDoc as Object
Dim oSheet as Object
Dim oCursor as Object
Dim oShtFirstCol as Long, oShtFirstRow as Long
Dim oShtEndCol as Long, oShtEndRow as Long
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCursor = oSheet.createCursor()
'
oDisp = "[ Cell Address of Sheet ]" & Chr$(10)
'
oShtFirstCol = oCursor.getRangeAddress().StartColumn
oShtFirstRow = oCursor.getRangeAddress().StartRow
'
oShtEndCol = oCursor.getRangeAddress().EndColumn
oShtEndRow = oCursor.getRangeAddress().EndRow
oDisp = oDisp & "First Cell = ( " & oShtFirstCol & " , " & oShtFirstRow & " )" & Chr$(10) & _
" End Cell = ( " & oShtEndCol & " , " & oShtEndRow & " )"
' Display
msgbox(oDisp,0,"Sheetの最初と最後のCell Address")
End Sub
'
' Refer to " Sheet操作/ Sheet Cursors / Simple Cursor Movement(2) "
CCA-)[Calc]
[ 行・列 ]
CCR-)[Calc]行の挿入(1)
sub Main()
Dim oDoc as Object
oDoc=ThisComponent
oSheet=oDoc.Sheets(0)
oRows = oSheet.getRows()
oRows.insertByIndex(16,3) '←17行目から3行挿入
End Sub
CCR-)[Calc]行の挿入(2)
Sub UnoInsertRow()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oFrame = ThisComponent.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "3:5"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:InsertRows", "", 0, Array())
'
msgbox "Success"
End Sub
CCR-)[Calc]列の挿入(1)
sub Main()
Dim oDoc as Object
oDoc=ThisComponent
oSheet=oDoc.Sheets(0)
oColumns = oSheet.getColumns()
oColumns.insertByIndex(2,3) '←C列目から3列挿入
End Sub
CCR-)[Calc]列の挿入(2)
Sub UnoInsertCol()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oFrame = ThisComponent.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "B:D"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:InsertColumns", "", 0, Array())
'
msgbox "Success"
End Sub
CCR-)[Calc]行の削除(1)
sub Main()
Dim oDoc as Object, oSheet as Object
Dim oRows as Object
oDoc=ThisComponent
oSheet=oDoc.Sheets(0)
oRows = oSheet.getRows()
oRows.removeByIndex(0,10) '←1行目から10列削除
End Sub
CCR-)[Calc]行の削除(2)
Sub UnoDeleteRow()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oFrame = ThisComponent.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "2:4"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:DeleteRows", "", 0, Array())
'
msgbox "Success"
End Sub
CCR-)[Calc]列の削除(1)
Sub Main()
Dim oDoc as Object, oSheet as Object
Dim oCols as Object
oDoc = ThisComponent
oSheet = oDoc.Sheets(0)
oCols = oSheet.getColumns()
oCols.removeByIndex(1, 4) '← B列から4列削除
msgbox "Success"
End Sub
CCR-)[Calc]列の削除(2)
Sub UnoDeleteCol()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oFrame = ThisComponent.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "B:D"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:DeleteColumns", "", 0, Array())
'
msgbox "Success"
End Sub
CCR-)[Calc]Cellの高さ値＆幅値を取得
Sub Height_Width_1
Dim oDoc As Object
Dim oCell As Object
oDoc=ThisComponent
oSheet=oDoc.sheets(0)
oCell=oSheet.getCellByPosition(0,0)
Unit_Hieght=oCell.getRows().Height
Unit_Width=oCell.getColumns().Width
End Sub
CCR-5)[Calc]全ての行高さ＆列幅を設定する。
Sub Height_Width_2
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oRows = oSheet.Rows
oColumns = oSheet.Columns
oRows.Height=1000 '全ての行高さ=1cm
oColumns.Width=5000 '全ての列幅=5cm
End Sub
CCR-)[Calc]行高さ＆列幅を設定(1)
Sub Height_Width_3()
Dim oDoc as Object, oSheet as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oSheet.Rows(0).Height=5000 '1行目の高さ=5cm
oSheet.Columns(1).Width=1000 'B列目の幅=1cm
End Sub
CCR-)[Calc]列高さ＆列幅を設定(2)
Sub UnoOptimalColRow()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oFrame = ThisComponent.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "1:1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "RowHeight"
oProp(0).Value = 2000 ' 20mm
oDispatcher.executeDispatch(oFrame, ".uno:RowHeight", "", 0, oProp())
msgbox "Set Row Height",0,"Set row and column"
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "B:B"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "ColumnWidth"
oProp(0).Value = 1000
oDispatcher.executeDispatch(oFrame, ".uno:ColumnWidth", "", 0, oProp())
msgbox "Set Colwmn Width",0,"Set row and column"
End Sub
CCR-)[Calc]行高さ＆列幅の最適化(1)
Sub ColRowOptimaize()
Dim oDoc as Object, oSheet as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oSheet.getColumns.OptimalWidth = true
oSheet.getRows.OptimalHeight = true
msgbox "Success"
End Sub
CCR-)[Calc]行高さ＆列幅の最適化(2)
Sub UnoOptimalColRow()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oFrame = ThisComponent.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A:A"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' 引数を省略すると最適な列幅Dialogが表示される。
oProp(0).Name = "aExtraWidth"
oProp(0).Value = 0
oDispatcher.executeDispatch(oFrame, ".uno:SetOptimalColumnWidth", "", 0, oProp())
msgbox "Optimal Colwmn Width",0,"Optimize"
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "1:2"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oProp(0).Name = "aExtraHeight"
oProp(0).Value = 0
oDispatcher.executeDispatch(oFrame, ".uno:SetOptimalRowHeight", "", 0, oProp())
msgbox "Optimal Row Height",0,"Optimize"
End Sub
CCR-)[Calc]選択範囲を新しい場所に行と列を入れ替えて貼り付ける(String型)
Sub CopyRowReplaceColString()
Dim oDoc as Object, oSheet as Object
Dim document as object, dispatcher as object
Dim oCellD as object
Dim oCopyRange as string
Dim oRangeDest as string
Dim args1(0) as new com.sun.star.beans.PropertyValue
Dim args2(5) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
document = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oCopyRange = "A1:C3" ' 列と行の数は一致させる
oRangeDest = "D4:F6" ' 列と行の数は一致させる
'
oCellD = oSheet.getCellRangeByName(oCopyRange)
oDoc.getCurrentController().select(oCellD)
'
args1(0).Name = "ToPoint"
args1(0).Value = oCopyRange
'
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
'
args2(0).Name = "Flags"
args2(0).Value = "SVD"
args2(1).Name = "FormulaCommand"
args2(1).Value = 0
args2(2).Name = "SkipEmptyCells"
args2(2).Value = false
args2(3).Name = "Transpose"
args2(3).Value = true
args2(4).Name = "AsLink"
args2(4).Value = false
args2(5).Name = "MoveMode"
args2(5).Value = 4
oCellD = oSheet.getCellRangeByName(oRangeDest)
oDoc.getCurrentController().select(oCellD)
dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args2())
msgbox "Success"
End Sub
CCR-9)[Calc]選択範囲を新しい場所に行と列を入れ替えて貼り付ける(Object型)
Sub subCopyRowReplaceColObject(oCopyRange as Object,oRangeDest as Object)
dim dispatcher as object
dim document as object
dim args1(5) as new com.sun.star.beans.PropertyValue
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
ThisComponent.getCurrentController().select(oCopyRange)
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
args1(0).Name = "Flags"
args1(0).Value = "SVD"
args1(1).Name = "FormulaCommand"
args1(1).Value = 0
args1(2).Name = "SkipEmptyCells"
args1(2).Value = false
args1(3).Name = "Transpose"
args1(3).Value = true
args1(4).Name = "AsLink"
args1(4).Value = false
args1(5).Name = "MoveMode"
args1(5).Value = 4
ThisComponent.getCurrentController().select(oRangeDest)
dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args1())
End Sub
CCR-10)[Calc]2行目＆C列を非表示後に再度表示設定にする。
Sub Hide_Visible
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oSheet.Rows(1).isVisible=false '2行目の非表示設定
oSheet.Columns(2).isVisible=false 'C列の非表示設定
oSheet.Rows(1).isVisible=true '2行目の表示設定
oSheet.Columns(2).isVisible=true 'C列の表示設定
End Sub
CCR-)[Calc]行高さ調整機能を無効化
Sub oIsAjustHiehgt
Dim oDoc As Object
oDoc=ThisComponent
oCell=oDoc.Sheets(0).getCellByPosition(0,0)
oCell.String = "LibreOffice マクロマニュアル"
oCell.IsTextWrapped = true
' Rowを選択してDouble ClickしてもRow高さを変更されない様にする。
oDoc.IsAdjustHeightEnabled = false
msgbox "Success"
End Sub
CCR-)[Calc]列のGroup化(1)
Sub ColRow()
Dim oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oFrame = ThisComponent.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "$B:$C"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oProp(0).Name = "RowOrCol"
oProp(0).Value = "C"
oDispatcher.executeDispatch(oFrame, ".uno:Group", "", 0, oProp())
msgbox("Goup化 OK",0,"Display")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "$B:$C"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oProp(0).Name = "RowOrCol"
oProp(0).Value = "C"
oDispatcher.executeDispatch(oFrame, ".uno:Ungroup", "", 0, oProp())
msgbox("Goup化解除 OK",0,"Display")
End Sub
CCR-)[Calc]列のGroup化(2)
Sub ColRow()
Dim oDoc as Object
Dim oSheet as Object
Dim oCellAdr as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr
.Sheet = 0
.StartColumn = 1 ' Column B
.EndColumn = 2 ' Column C
end with
oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.COLUMNS )
msgbox("Goup化 OK",0,"Display")
'
oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr
.Sheet = 0
.StartColumn = 1 ' Column B
.EndColumn = 2 ' Column C
end with
oSheet.ungroup( oCellAdr, com.sun.star.table.TableOrientation.COLUMNS )
msgbox("Goup化解除 OK",0,"Display")
End Sub
CCR-)[Calc]行のGroup化(1)
Sub ColRow()
Dim oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oFrame = ThisComponent.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "$3:$5"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oProp(0).Name = "RowOrCol"
oProp(0).Value = "R"
oDispatcher.executeDispatch(oFrame, ".uno:Group", "", 0, oProp())
msgbox("Goup化 OK",0,"Display")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "$3:$5"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
'
oProp(0).Name = "RowOrCol"
oProp(0).Value = "R"
oDispatcher.executeDispatch(oFrame, ".uno:Ungroup", "", 0, oProp())
msgbox("Goup化解除 OK",0,"Display")
End Sub
CCR-)[Calc]行のGroup化(2)
Sub ColRow()
Dim oDoc as Object
Dim oSheet as Object
Dim oCellAdr as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr
.Sheet = 0
.StartRow = 2 ' Row No.3
.EndRow = 4 ' Row No.4
end with
oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
msgbox("Goup化 OK",0,"Display")
'
oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr
.Sheet = 0
.StartRow = 2 ' Row No.3
.EndRow = 4 ' Row No.4
end with
oSheet.ungroup( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
msgbox("Goup化解除 OK",0,"Display")
End Sub
CCR-)[Calc]Sheet内の全てのGoup化の削除
Sub ColRow()
Dim oDoc as Object
Dim oSheet as Object
Dim oCellAdr as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr
.Sheet = 0
' 1つ目のGroup
.StartColumn = 1
.EndColumn = 2
' 2つ目のGropu
.StartRow = 2 ' Row No.3
.EndRow = 4 ' Row No.4
end with
oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.COLUMNS )
oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
msgbox("Goup化 OK",0,"Display")
'
oSheet.clearOutline()
msgbox("全てのGoup化解除 OK",0,"Display")
End Sub
CCR-)[Calc]Sheet内の全てのGoup化の削除(2)
Sub ColRow()
Dim oDoc as Object
Dim oSheet as Object
Dim oCellAdr as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr
.Sheet = 0
' 1つ目のGroup
.StartColumn = 1
.EndColumn = 2
' 2つ目のGropu
.StartRow = 2 ' Row No.3
.EndRow = 4 ' Row No.4
end with
oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.COLUMNS )
oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
msgbox("Goup化 OK",0,"Display")
'
' Group化の削除
Dim oFrame as Object
Dim oDispatcher as Object
Dim oProp()
oFrame = oDoc.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
' Outlineの削除
oDispatcher.executeDispatch(oFrame, ".uno:ClearOutline", "", 0, oProp())
msgbox("全てのGoup化解除 OK",0,"Display")
End Sub
CCR-)[Calc]Goupの表示/非表示
Sub ColRow()
Dim oDoc as Object
Dim oSheet as Object
Dim oCellAdr as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr
.Sheet = 0
' 1つ目のGroup
.StartColumn = 1
.EndColumn = 2
' 2つ目のGropu
.StartRow = 2 ' Row No.3
.EndRow = 4 ' Row No.4
end with
oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.COLUMNS )
oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
msgbox("Goup化 OK",0,"Display")
'
oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr
.Sheet = 0
' 1つ目のGroup
.StartColumn = 1
.EndColumn = 2
end with
oSheet.hideDetail( oCellAdr )
msgbox("Goup部の非表示化 OK",0,"Display")
'
oSheet.ShowDetail( oCellAdr )
msgbox("Goup部の表示化 OK",0,"Display")
End Sub
CCR-)[Calc]Outlineの自動作成
Sub ColRow()
Dim oDoc as Object
Dim oSheet as Object
Dim oCellAdr as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr
.Sheet = 0
.StartRow = 1 ' ← 正確な範囲指定は不要
.EndRow = 10 ' ← 但し、範囲内に無いDataは 自動Outline(Group化)は作成されない
end with
' Outlineの自動作成
oSheet.autoOutline(oCellAdr)
msgbox("Outlineの自動作成 → OK",0,"Outline")
'
' Outlineの削除
oSheet.clearOutline()
msgbox("全てのGoup化解除 OK",0,"Display")
End Sub
'
' Outlineの自動作成については http://help.libreoffice.org/Calc/AutoOutline/ja を参照
'
' [ 注意 ]
' = Sum(A1:A3) → OK
' = A1 + A2 + A3 → NG
'
CCR-)[Calc]Outlineの自動作成(2)
Sub ColRow()
Dim oFrame as Object
Dim oDispatcher as Object
Dim oProp()
oFrame = ThisComponent.CurrentController.Frame
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
' Outlineの自動作成
oDispatcher.executeDispatch(oFrame, ".uno:AutoOutline", "", 0, oProp())
msgbox("Outlineの自動作成 → OK",0,"Outline")
'
' Outlineの削除
oDispatcher.executeDispatch(oFrame, ".uno:ClearOutline", "", 0, oProp())
msgbox("Outlineの削除 → OK",0,"Outline")
End Sub
CCR-)[Calc]任意Levelまで一度に表示
Sub ColRow()
Dim oDoc as Object
Dim oSheet as Object
Dim oCellAdr1 as Object
Dim oCellAdr2 as Object
Dim oCellAdr3 as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
oCellAdr1 = createUnoStruct("com.sun.star.table.CellRangeAddress")
' 1 Level目のGroup作成
with oCellAdr1
.Sheet = 0
.StartRow = 0
.EndRow = 10
end with
oSheet.group( oCellAdr1, com.sun.star.table.TableOrientation.ROWS )
'
' 2 Level目のGroup作成
oCellAdr2 = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr2
.Sheet = 0
.StartRow = 2
.EndRow = 8
end with
oSheet.group( oCellAdr2, com.sun.star.table.TableOrientation.ROWS )
'
' 3 Level目のGroup作成
oCellAdr3 = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oCellAdr3
.Sheet = 0
.StartRow = 4
.EndRow = 5
end with
oSheet.group( oCellAdr3, com.sun.star.table.TableOrientation.ROWS )
'
' 3Level を非表示
oSheet.hideDetail( oCellAdr3 ) ' 範囲が小さいものから非表示化 / 手作業と同じ
' 2Level を非表示
oSheet.hideDetail( oCellAdr2 )
' 1Level を非表示
oSheet.hideDetail( oCellAdr1 )
msgbox("Goupの非表示化完了",0,"Display")
'
' 2 Levelまで一度に表示
oSheet.showLevel(2,com.sun.star.table.TableOrientation.ROWS)
msgbox("2 Levelまで展開",0,"Display")
'
' Outlineの削除
oSheet.clearOutline()
msgbox("全てのGoup化解除 OK",0,"Display")
End Sub
[ HyperLink ]
CCH-)[Calc]HyperLink設定(1)
Sub HyperLinkCell
dim 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="B1" ←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())
End Sub
CCH-)[Calc]HyperLink設定(2)
Sub HyperLinkCell
Dim oDoc as Object
Dim oSheet as Object
Dim 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
[ Array ]
CCD-)[Calc]配列の文字列を纏める
Sub Main5()
Dim oItems(0 to 2) as String
Dim str as String
oItems(0)="123"
oItems(1)="abc"
oItems(2)="456"
str=Join(Items,"+")
Print str
End Sub
CCD-)[Calc]文字列を分割して、配列として返す。(CSV fileを扱うときに便利)
Sub Main4
Dim Items()
Items=Split("Apple,Orange,Lemon",",")
Print Items(0),Items(1),Items(2)
End Sub
CCD-)[Calc]指定範囲のDataを全て取得
Sub oGetAndSetData
Dim oRange
Dim oSheet
Dim oAllData
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:G10")
'Get Data
oAllData = oRange.getDataArray()
for i = 0 to Ubound(oAllData)
oDisp = oDisp & " " & Join(oAllData(i), " : ") & " " & Chr$(10)
next i
msgbox(oDisp,0,"Data In Range")
End Sub
CCD-)[Calc]指定範囲にDataを入力
Sub oGetAndSetData
Dim oRange
Dim oSheet
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:B2")
'Set Data
oRange.setDataArray(Array(Array("A1", "B1"), Array("A2", "B2")))
End Sub
CCD-)[Calc]Array Fourmula
Sub CalcArrayFormula()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oRange as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
'Set the two top cells
oCell = oSheet.getCellByPosition(1,2)
oCell.setValue(1)
oCell = oSheet.getCellByPosition(2,2)
oCell.setValue(3)
'Fill the Values Down
oRange = oSheet.getCellRangeByName("B3:C8")
oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, 1)
'Setting each cell individually
for i=3 to 8
oCell = oSheet.getCellByPosition(3, i-1)
oCell.setFormula("=B" & i & "+C" & i)
next i
'Setting a single array formula
oRange = oSheet.getCellRangeByName("E3:E8")
oRange.setArrayFormula("=B3:B8+C3:C8")
'Title for Column
oRange = oSheet.getCellRangeByName("B2:E2")
oRange.setDataArray(Array(Array("B", "C", "Formula", "Array Formula")))
'
msgbox "Success",0,"Array Formula"
End Sub
[ Sort ]
CCS-1)[Calc]指定範囲を任意の列の昇順でソートする
Sub DataSort(oRange as object,iCol as integer)
Dim descriptors_obj(1) As New com.sun.star.beans.PropertyValue
Dim sortFields(0) As New com.sun.star.util.SortField
sortFields(0).Field = iCol
sortFields(0).SortAscending = True
descriptors_obj(0).Name = "SortFields"
descriptors_obj(0).Value = sortFields()
descriptors_obj(1).Name = "ContainsHeader"
descriptors_obj(1).Value = False
oRange.sort(descriptors_obj())
End Sub
CCS-1)[Calc]数字としてSort
Sub oShortColOne
Dim oSheet
Dim oRange
Dim oSortFields(0) as new com.sun.star.util.SortField
Dim oSortDesc(0) as new com.sun.star.beans.PropertyValue
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:A10")
oSortFields(0).Field = 0
oSortFields(0).SortAscending = true
oSortFields(0).FieldType = com.sun.star.util.SortFieldType.NUMERIC
oSortDesc(0).Name = "SortFields"
oSortDesc(0).Value = oSortFields()
oRange.Sort(oSortDesc())
End Sub
CCS-1)[Calc]Text DataとしてSort
Sub oShortColOne
Dim oSheet
Dim oRange
Dim oSortFields(0) as new com.sun.star.util.SortField
Dim oSortDesc(0) as new com.sun.star.beans.PropertyValue
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:A10")
oSortFields(0).Field = 0
oSortFields(0).SortAscending = true
oSortFields(0).FieldType = com.sun.star.util.SortFieldType.ALPHANUMERIC
oSortDesc(0).Name = "SortFields"
oSortDesc(0).Value = oSortFields()
oRange.Sort(oSortDesc())
End Sub
CCS-1)[Calc]Sort Descriptor
Sub oDisplaySortDescriptor
On Error Resume Next
Dim oSheet
Dim oRange
Dim oSortDescript()
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("B28:D33")
oSortDescript = oRange.createSortDescriptor()
for i = LBound(oSortDescript) to UBound(oSortDescript)
oDisp = oDisp & oSortDescript(i).Name & " = "
oDisp = oDisp & oSortDEscript(i).Value
oDisp = oDisp & Chr$(10)
next
msgbox(oDisp,0,"Sort Descriptor")
End Sub
[ Filter ]
CCFlt-)[Calc]AutoFilterの設定/解除(1)
Sub SetAutoFlter()
Dim oDoc as Object
Dim oSheet as Object
Dim oDbRanges as Object
Dim oRange as Object
Dim oRangeName as String
Dim oFilterRange as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
oDBRanges = oDoc.DatabaseRanges
oRange = oSheet.getCellRangeByPosition(0,0,1,1000) ' A1 ～ B1001
' AutoFilterを設定するRangeにNameを付ける( 必須 )
oRangeName = "RangeName"
'
' 同じRange Nameを付けようとするとCrashするので、同名Range Nameは一旦、削除する
If oDBRanges.hasByName(oRangeName) Then
oDBRanges.removeByName(oRangeName)
End If
' A1 ～ B1001の範囲にRange Nameを設定する
oDBRanges.addNewByName(oRangeName, oRange.RangeAddress)
' Range Objectを取得
oFilterRange = oDBRanges.getByName(oRangeName)
' AutoFilter 設定 ON
oFilterRange.AutoFilter = true
' Display
msgbox "AutoFilter設定完了"
'
' AutoFilter 解除
oFilterRange.AutoFilter = false
' Display
msgbox "AutoFilter解除完了"
End Sub
CCFlt-)[Calc]AutoFilterの設定/解除(2)
Sub UnoSetAutoFlter()
Dim oDoc as Object, oSheet as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
'まずオートフィルタの範囲を選択します。(アクティブなセルを指定)
oCtrl.select (oSheet.getCellRangeByName ("A1:B1001"))
'オートフィルタ設定 ON
oDispatcher.executeDispatch(oFrame, ".uno:DataFilterAutoFilter", "", 0, Array())
msgbox "AutoFilter設定完了",0,"AutoFilter"
'オートフィルタ設定 OFF
oDispatcher.executeDispatch(oFrame, ".uno:DataFilterAutoFilter", "", 0, Array())
msgbox "AutoFilter設定解除",0,"AutoFilter"
End Sub
CCFlt-)[Calc]AutoFilterでFiltering
Sub SetAutoFlter()
Dim oDoc as Object
Dim oSheet as Object
Dim oDbRanges as Object
Dim oRange as Object
Dim oRangeName as String
Dim oFilterRange as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
oDBRanges = oDoc.DatabaseRanges
oRange = oSheet.getCellRangeByPosition(0,0,1,1000) ' A1 ～ B1001
' AutoFilterを設定するRangeにNameを付ける( 必須 )
oRangeName = "RangeName"
'
' 同じRange Nameを付けようとするとCrashするので、同名Range Nameは一旦、削除する
If oDBRanges.hasByName(oRangeName) Then
oDBRanges.removeByName(oRangeName)
End If
' A1 ～ B1001の範囲にRange Nameを設定する
oDBRanges.addNewByName(oRangeName, oRange.RangeAddress)
' Range Objectを取得
oFilterRange = oDBRanges.getByName(oRangeName)
' AutoFilter 設定 ON
oFilterRange.AutoFilter = true
'
' AutoFilter Display
Dim oFilterDisp as Object
oFilterDisp = oFilterRange.FilterDescriptor
'
' FilterFieldの作成が必要 ' FilterFieldsでは上手くいかない？
Dim oFilterItem(0) As New com.sun.star.sheet.TableFilterField ' AutoFilter では 条件Columnは１つしか無いので 0 だけらしい。
With oFilterItem(0)
.Connection = com.sun.star.sheet.FilterConnection.AND ' com.sun.star.sheet.FilterConnection.OR でも同じらしい
.Field = 0
.Operator = com.sun.star.sheet.FilterOperator.EQUAL
.IsNumeric = true
.NumericValue = 5
End With
' Set
oFilterDisp.setFilterFields( oFilterItem )
'
' Filter 範囲の表示の更新
oFilterRange.refresh()
'
msgbox("設定1",0,"AutoFilterの設定")
'
' 2回目の設定
With oFilterItem(0)
.Connection = com.sun.star.sheet.FilterConnection.OR
.Field = 1
.Operator = com.sun.star.sheet.FilterOperator.EQUAL
.IsNumeric = false
.StringValue = "Taro"
End With
' Set
oFilterDisp.setFilterFields( oFilterItem )
'
' Filter 範囲の表示の更新
oFilterRange.refresh()
'
msgbox("設定2",0,"AutoFilterの設定")
End Sub
CCFlt-)[Calc]標準Filter設定Dialog表示
Sub UnoSetStdFlter()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' DIsplay Dialog
oDispatcher.executeDispatch(oFrame, ".uno:DataFilterStandardFilter", "", 0, Array())
msgbox "Succcess",0,"Filter"
End Sub
CCFlt-)[Calc]特殊Filter設定Dialog表示
Sub UnoSetSpecialFlter()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' DIsplay Dialog
oDispatcher.executeDispatch(oFrame, ".uno:DataFilterSpecialFilter", "", 0, Array())
msgbox "Succcess",0,"Filter"
End Sub
CCFlt-)[Calc]標準/特殊Filter解除(1)
Sub RemoveSheetFilter()
Dim oDoc as Object, oSheet as Object
Dim oFilterDesc as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oFilterDesc = oSheet.createFilterDescriptor(True)
oSheet.filter(oFilterDesc)
msgbox "Success",0,"Remove Filter"
End Sub
CCFlt-)[Calc]標準/特殊Filter解除(2)
Sub UnoRemoveSheetFilter()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oSheet as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' Filter Area
oSheet = oDoc.getSheets().getByIndex(0)
oCtrl.select (oSheet.getCellRangeByName ("A1:C100"))
' Remove Filter
oDispatcher.executeDispatch(oFrame, ".uno:DataFilterRemoveFilter", "", 0, Array())
msgbox "Succcess( Uno )",0,"Remove Filter"
End Sub
CCFlt-)[Calc]
[ Search ]
CCSh-1)[Calc]Simple Search
Sub oSearchSheet
Dim oSheet
oSheet = ThisComponent.Sheets(1)
oSearch = oSheet.createSearchDescriptor()
With oSearch
.SearchString = "newOoo3" ' <= 検索文字
.SearchWords = false ' <= 検索文字が一部含まれる(false),絶対一致(true)。 大文字と小文字の区別無し
.SearchCaseSensitive = false ' <= 大文字小文字区別( true )
End With
' Search
oFind = oSheet.findFirst(oSearch)
oDisp = oFind.getString()
msgbox( oDisp )
End Sub
CCSh-2)[Calc]Simple Replace
Sub oSearchSheet
Dim oSheet
oSheet = ThisComponent.Sheets(1)
oSearch = oSheet.createReplaceDescriptor()
With oSearch
.SearchString = "newOoo3" ' ← 検索文字
.ReplaceString = "OpenOffice.org" ' ← 置換文字
.SearchWords = true ' ← 検索文字が一部含まれる(false),絶対一致(true)。 大文字と小文字の区別無し
.SearchCaseSensitive = false ' ← 大文字小文字区別( true )
End With
' Relace
oDisp = oSheet.replaceAll(oSearch)
msgbox( oDisp, 0, "置換した数" )
End Sub
CCSh-)[Calc]Cell内改行を検索
Sub oSearchSheet
Dim oSheet
oSheet = ThisComponent.Sheets(0)
oSearch = oSheet.createSearchDescriptor()
With oSearch
REM ' 検索は出来るが、任意の文字をCell内改行はほぼ出来ない。
REM ' 正確には置換しているが、Cell内改行されている様に表示されない。
REM ' 対象Cellを手動で選択するとセル内改行されている事が分る。
.SearchString = Chr$(10)
.SearchWords = false ' ← 検索文字が一部含まれる(false),絶対一致(true)。 大文字と小文字の区別無し
.SearchCaseSensitive = false ' ← 大文字小文字区別( true )
End With
' Search
oFind = oSheet.findFirst(oSearch)
oDisp = oFind.getString()
msgbox( oDisp )
End Sub
[ Merge ]
CCM-)[Calc]Cellの結合/結合解除(1)
Sub CellMerge()
Dim oDoc as Object, oSheet as Object
Dim oRange as Object
oDoc = ThisComponent
oSheet = oDoc.Sheets().getByIndex(0)
oRange = oSheet.getCellRangeByName("A1:B2")
'
oRange.merge(true)
msgbox "Merge cell",0,"Merge of Cell"
'
oRange.merge(false)
msgbox "Split cell",0,"Merge of Cell"
End Sub
CCM-)[Calc]Cellの結合/結合解除(2)
Sub UnoMergeCell()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1:B3"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' Merge cells
oDispatcher.executeDispatch(oFrame, ".uno:MergeCells", "", 0, Array())
msgbox "Merge Cells" & Chr$(10) & "(DispatchHelper)",0,"Merge of Cell"
' Split cell
oDispatcher.executeDispatch(oFrame, ".uno:SplitCell", "", 0, Array())
msgbox "Split Cell" & Chr$(10) & "(DispatchHelper)",0,"Merge of Cell"
End Sub
CCM-)[Calc]結合されたセル(事前に選択)のサイズを調べる(その1)
Sub UnoCellMerge()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as object
Dim oCell as Object
oDoc = ThisComponent
oCtrl = oDoc.getSheets().getByName("sheet1")
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:ToggleMergeCells", "", 0, Array())
oCell = ThisComponent.CurrentController.getSelection()
cs=oCell.RangeAddress.StartColumn
rs=oCell.RangeAddress.StartRow
ce=oCell.RangeAddress.EndColumn
re=oCell.RangeAddress.EndRow
oWidth=0
oHeight=0
for i=cs to ce
oW=ThisComponent.Sheets(0).getCellByPosition(i,0)
oWidth_tmp=oW.getColumns().Width
oWidth = oWidth + oWidth_tmp
next
for i=rs to re
oH=ThisComponent.Sheets(0).getCellByPosition(0,i)
oHeight_tmp=oH.getRows().Height
oHeight= oHieght + oHeight_tmp
next
oDispatcher.executeDispatch(oFrame, ".uno:ToggleMergeCells", "", 0, Array())
MsgBox("結合セルの幅 ： " & oWidth &Chr(10) & _
"結合セルの高さ ： " & oHeight)
End Sub
CCM-)[Calc]結合されたセル(事前に選択)のサイズを調べる(その2)
Option VBASupport 1
Sub MergeCell2()
Dim oSheet As Object
Dim oCursor As Object
Dim oSelection As Object
Dim oWidth As Long
Dim oHeight As Long
oSheet =ThisComponent.CurrentController.ActiveSheet
oSelection = ThisComponent.CurrentSelection
oCursor = oSheet.createCursorByRange( oSelection )
oCursor.collapseToMergedArea()
oWidth = oCursor.Size.Width
oHeight = oCursor.Size.Height
MsgBox("結合セルの幅 ： " & oWidth &Chr(10) & _
"結合セルの高さ ： " & oHeight)
End Sub
[ Note ] ：(その1)と(その2)の違い
(その1) ： セルの結合解除 ⇒ 選択範囲の各セルサイズ(幅、高さ)を取得 ⇒ 各セルサイズを足し合わせる ⇒ 再度セルの結合を実施
(その2) ： 結合セルのAreaサイズを直接取得。(その1)に比べると少し調査精度が低いが、概略サイズの取得ならばこちらのコードの方がSmartである。
CCM-)[Calc]各Sheet内に結合しているセルがあるかどうか調べる。
Sub sheet_by_enumeration()
Dim oSheetsEnumeration As Object, oSheets As Object
oSheets = ThisComponent.getSheets()
oSheetsEnumeration = oSheets.createEnumeration()
While ( oSheetsEnumeration.hasMoreElements() )
MsgBox oSheetsEnumeration.nextElement.IsMerged()
WEnd
End Sub
[ Calc Function ]
CCFc-)[Calc]Find
Sub oFunction
Dim oFunction(2)
ShtFnc = CreateUnoService("com.sun.star.sheet.FunctionAccess")
oSource = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
oFunction(0) = "T"
oFunction(1) = oSource
oFunction(2) = 1
oPosFind = ShtFnc.callFunction("Find", oFunction())+1
msgbox(oFunction(0) & " => " & oPosFind & " 文字目",0,"Calc Function")
End Sub
CCFc-)[Calc]値をValue形式にする
Sub oFunction
Dim oFunction(0)
ShtFnc = CreateUnoService("com.sun.star.sheet.FunctionAccess")
oFunction(0) = "1,234"
oPosFind = ShtFnc.callFunction("Value", oFunction())
msgbox(oFunction(0) & " → " & oPosFind ,0,"Calc Function")
End Sub
CCFc-)[Calc]値をText形式にする
Sub oFunction
Dim oFunction(0)
ShtFnc = CreateUnoService("com.sun.star.sheet.FunctionAccess")
oFunction(0) = "1,234"
oPosFind = ShtFnc.callFunction("T", oFunction())
msgbox(oFunction(0) & " => " & oPosFind ,0,"Calc Function")
End Sub
CCFc-)[Calc]指定範囲の合計(1)[連続範囲]
Sub UseComputeSum()
Dim oRange as Object
Dim oSheet as Object
Dim oResult as double
oSheet = ThisComponent.Sheets(0)
oRange = oSheet.getCellRangeByName("A1:B5")
oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.SUM )
oDisp = "A1:B5 => Sum = " & oResult & Chr$(10) & "文字列･空白は自動的に除外"
msgbox(oDisp,0,"ComputerFunction")
End Sub
'
' [ Note ]
' 1) 範囲内に文字列、空白があってもOK。式値は含まれる。
CCFc-)[Calc]指定範囲の合計(2)[不連続範囲]
Sub UseComputeSum()
Dim oRange(1) as Object
Dim oSheet as Object
Dim oResult as Double
oSheet = ThisComponent.Sheets(0)
oRange(0) = oSheet.getCellRangeByName("A1:A5")
oRange(1) = oSheet.getCellRangeByName("D1:D5")
oResult = 0
for i = 0 to UBound(oRange)
oResult = oResult + oRange(i).computeFunction(com.sun.star.sheet.GeneralFunction.SUM )
next i
oDisp = "A1:A5/D1:D5 → Sum = " & oResult & Chr$(10) & "文字列･空白は自動的に除外"
msgbox(oDisp,0,"ComputerFunction")
End Sub
CCFc-)[Calc]空白以外のCell数
Sub oUseCompute
Dim oRange
Dim oSheet
Dim oResult as double
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:B5")
oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.COUNT )
oDisp = "A1:B5 => COUNT = " & oResult & Chr$(10) & "空白以外のCell数"
msgbox(oDisp,0,"ComputerFunction")
End Sub
CCFc-)[Calc]指定範囲の平均
Sub oUseCompute
Dim oRange
Dim oSheet
Dim oResult as double
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:B5")
oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.AVERAGE )
oDisp = "A1:B5 => Average = " & oResult & Chr$(10) & "平均"
msgbox(oDisp,0,"ComputerFunction")
End Sub
CCFc-)[Calc]最大値
Sub oUseCompute
Dim oRange
Dim oSheet
Dim oResult as double
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:B5")
oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.MAX )
oDisp = "A1:B5 => MAX = " & oResult & Chr$(10) & "MAX値"
msgbox(oDisp,0,"ComputerFunction")
End Sub
CCFc-)[Calc]最小値
Sub oUseCompute
Dim oRange
Dim oSheet
Dim oResult as double
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:B5")
oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.MIN )
oDisp = "A1:B5 => MIN = " & oResult & Chr$(10) & "MIN値"
msgbox(oDisp,0,"ComputerFunction")
End Sub
CCFc-)[Calc]Product
Sub oUseCompute
Dim oRange
Dim oSheet
Dim oResult as double
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:B5")
oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.PRODUCT )
oDisp = "A1:B5 => PRODUCT = " & oResult & Chr$(10) & "PRODUCT値"
msgbox(oDisp,0,"ComputerFunction")
End Sub
CCFc-)[Calc]数値Cellの数
Sub oUseCompute
Dim oRange
Dim oSheet
Dim oResult as double
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:B5")
oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.COUNTNUMS )
oDisp = "A1:B5 => COUNTNUMS = " & oResult & Chr$(10) & "COUNTNUMS値"
msgbox(oDisp,0,"ComputerFunction")
End Sub
CCFc-)[Calc]推定標準偏差
Sub oUseCompute
Dim oRange
Dim oSheet
Dim oResult as double
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:B5")
oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.STDEV )
oDisp = "A1:B5 => STDEV = " & oResult & Chr$(10) & "STDEV値"
msgbox(oDisp,0,"ComputerFunction")
End Sub
CCFc-)[Calc]標準偏差
Sub oUseCompute
Dim oRange
Dim oSheet
Dim oResult as double
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:B5")
oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.STDEVP )
oDisp = "A1:B5 => STDEVP = " & oResult & Chr$(10) & "STDEVP値"
msgbox(oDisp,0,"ComputerFunction")
End Sub
CCFc-)[Calc]標本に基づいて分散を予測
Sub oUseCompute
Dim oRange
Dim oSheet
Dim oResult as double
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:B5")
oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.VAR )
oDisp = "A1:B5 => VAR = " & oResult & Chr$(10) & "VAR値"
msgbox(oDisp,0,"ComputerFunction")
End Sub
CCFc-)[Calc]母集団に基づき、分散
Sub oUseCompute
Dim oRange
Dim oSheet
Dim oResult as double
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:B5")
oResult = oRange.computeFunction(com.sun.star.sheet.GeneralFunction.VARP )
oDisp = "A1:B5 => VARP = " & oResult & Chr$(10) & "VARP値"
msgbox(oDisp,0,"ComputerFunction")
End Sub
CCFc-)[Calc]Auditing Function
Sub oQUaryRange
Dim oSheet
Dim oCell
oSheet = ThisComponent.Sheets(1)
oCell = oSheet.getCellByposition(0,7) ' A8 = Sum(A1:A7)
oCellAd = oCell.CellAddress
oDisp1= oSheet.showPrecedents(oCellAd)
oDisp2= oSheet.hidePrecedents(oCellAd)
oDisp3= oSheet.showDependents(oCellAd)
oDisp4= oSheet.hideDependents(oCellAd)
oDisp5= oSheet.showErrors(oCellAd)
oDisp6= oSheet.showInvalid()
oDisp7= oSheet.clearArrows()
oDisp = "[ A8 = SUM(A1:A7) ]" & Chr$(10) & Chr$(10)
oDisp= oDisp & "oSheet.showPrecedents(oCell.Address) = " & oDisp1 & Chr$(10)
oDisp= oDisp & "oSheet.hidePrecedents(oCell.Address) = " & oDisp2 & Chr$(10)
oDisp= oDisp & "oSheet.showDependents(oCell.Address) = " & oDisp3 & Chr$(10)
oDisp= oDisp & "oSheet.hideDependents(oCell.Address) = " & oDisp4 & Chr$(10)
oDisp= oDisp & "oSheet.showErrors(oCell.Address) = " & oDisp5 & Chr$(10)
oDisp= oDisp & "oSheet.showInvalid() = " & oDisp6 & Chr$(10)
oDisp= oDisp & "oSheet.clearArrows() = " & oDisp7 & Chr$(10)
MsgBox(oDisp,0,"com.sun.star.sheet.XSheetAuditing Intrface")
End Sub
CCFc-)[Calc]指定Cellの参照元の表示
Sub CalcFunctionAuding()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oRowNo as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
'
' 事前準備
oRowNo = 6
for i = 0 to oRowNo
oCell = oSheet.getCellByPosition( 0, i )
oCell.Value = i
next i
for i = 0 to oRowNo
oCell = oSheet.getCellByPosition( 1, i )
if i = 3 then
oCell.Formula = "= A2"
else
oCell.Value = i
end if
next i
oSheet.getCellByPosition( 0, oRowNo + 1 ).Formula = "=Sum(A1:A" & oRowNo + 1 & ")"
'
' 指定Cellの参照元を表示
oCell = oSheet.getCellByPosition( 0, oRowNo + 1 ) ' A7 の参照元から矢印。
oSheet.showPrecedents(oCell.CellAddress)
'
msgbox "Success" & Chr$(10) & "( showPrecedents )"
End Sub
CCFc-)[Calc]指定Cellの参照先の表示
Sub CalcFunctionAuding()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oRowNo as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
'
' 事前準備
oRowNo = 6
for i = 0 to oRowNo
oCell = oSheet.getCellByPosition( 0, i )
oCell.Value = i
next i
for i = 0 to oRowNo
oCell = oSheet.getCellByPosition( 1, i )
if i = 3 then
oCell.Formula = "= A2"
else
oCell.Value = i
end if
next i
oSheet.getCellByPosition( 0, oRowNo + 1 ).Formula = "=Sum(A1:A" & oRowNo + 1 & ")"
'
' 指定Cellの参照先を表示
oCell = oSheet.getCellByPosition( 0, 1 ) ' A2 の参照先を矢印。共に参照されているCell も囲まれる。表示結果は showPrecedents と同じ
oSheet.showDependents(oCell.CellAddress)
'
msgbox "Success" & Chr$(10) & "( showDependents )"
End Sub
CCFc-)[Calc]Formula Cellの参照元の表示削除(1a)
Sub CalcFunctionAuding()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oRowNo as Integer
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
'
' 事前準備
oRowNo = 6
for i = 0 to oRowNo
oCell = oSheet.getCellByPosition( 0, i )
oCell.Value = i
next i
for i = 0 to oRowNo
oCell = oSheet.getCellByPosition( 1, i )
if i = 3 then
oCell.Formula = "= A2"
else
oCell.Value = i
end if
next i
oSheet.getCellByPosition( 0, oRowNo + 1 ).Formula = "=Sum(A1:A" & oRowNo + 1 & ")"
'
' 指定Cellの参照元を表示
oCell = oSheet.getCellByPosition( 0, oRowNo + 1 )
oSheet.showPrecedents(oCell.CellAddress)
oDisp = "指定Cellの参照元を表示"
msgbox(oDisp, 0, "showPrecedents")
'
' 参照先表示の削除
if oSheet.hideDependents(oCell.CellAddress) then
oDisp = "参照先表示を削除しました"
else
oDisp = "参照先表示は" & Chr$(10) & "設定されていません。"
end if
msgbox(oDisp, 0,"hideDependents")
'
if oSheet.hidePrecedents(oCell.CellAddress) then
oDisp = "参照元を削除しました"
else
oDisp = "参照元表示は" & Chr$(10) & "設定されていません。"
end if
msgbox(oDisp, 0,"hideDependents")
End Sub
CCFc-)[Calc]指定CellのError元を参照(1)
Sub CalcFunctionAuding()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oRowNo as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
'
' 事前準備
oRowNo = 6
for i = 0 to oRowNo
oCell = oSheet.getCellByPosition( 0, i )
if i = 1 then
oCell.Formula = "= B4"
else
oCell.Value = i
end if
next i
for i = 0 to oRowNo
oCell = oSheet.getCellByPosition( 1, i )
if i = 3 then
oCell.Formula = "= A2"
else
oCell.Value = i
end if
next i
oSheet.getCellByPosition( 0, oRowNo + 1 ).Formula = "=Sum(A1:A" & oRowNo + 1 & ")"
'
' 指定CellのError元Cellを表示
oCell = oSheet.getCellByPosition( 0, oRowNo + 1 ) ' A7 のError元から矢印。
oSheet.showErrors(oCell.CellAddress)
'
msgbox "Success" & Chr$(10) & "( showErrors )"
End Sub
CCFc-)[Calc]指定CellのError元を参照(2)
Sub CalcFunctionAuding()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oRowNo as Integer
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
'
' 事前準備
oRowNo = 6
for i = 0 to oRowNo
oCell = oSheet.getCellByPosition( 0, i )
if i = 1 then
oCell.Formula = "= B4"
else
oCell.Value = i
end if
next i
for i = 0 to oRowNo
oCell = oSheet.getCellByPosition( 1, i )
if i = 3 then
oCell.Formula = "= A2"
else
oCell.Value = i
end if
next i
oSheet.getCellByPosition( 0, oRowNo + 1 ).Formula = "=Sum(A1:A" & oRowNo + 1 & ")"
'
' ErrorのCellに移動 & Trace
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oProp(0).Name = "ToPoint"
oProp(0).Value = "A8"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:ShowErrors", "", 0, Array())
'
msgbox "Success" & Chr$(10) & "( uno:ShowErrors )"
End Sub
CCFc-)[Calc]Sheet中の全ての参照表示を削除
Sub CalcFunctionAuding()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oRowNo as Integer
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
'
' 事前準備
oRowNo = 6
for i = 0 to oRowNo
oCell = oSheet.getCellByPosition( 0, i )
if i = 1 then
oCell.Formula = "= B4"
else
oCell.Value = i
end if
next i
for i = 0 to oRowNo
oCell = oSheet.getCellByPosition( 1, i )
if i = 3 then
oCell.Formula = "= A2"
else
oCell.Value = i
end if
next i
oSheet.getCellByPosition( 0, oRowNo + 1 ).Formula = "=Sum(A1:A" & oRowNo + 1 & ")"
'
' Sheetの参照Cellを表示
oCell = oSheet.getCellByPosition( 0, oRowNo + 1 ) ' A7 のError元から矢印。
oSheet.showErrors(oCell.CellAddress)
oDisp = "指定CellのErrorCellの" & Chr$(10) & "参照を表示しました。"
msgbox(oDisp, 0, "showErrors")
'
' Sheet中の参照を全て削除
oSheet.clearArrows()
oDisp = "Sheet中の全ての参照表示を" & Chr$(10) & "削除しました。"
msgbox(oDisp, 0, "clearArrows")
End Sub
CCFc-)[Calc]Trace → 自動更新ON/OFF
Sub UnoAuding()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp(0).Name = "AutoRefreshArrows"
oProp(0).Value = false ' ON : true / OFF : false
oDispatcher.executeDispatch(oFrame, ".uno:AutoRefreshArrows", "", 0, Array())
msgbox "自動更新をOFFにしました。"
End Sub
'
' IDEからの実行では反映しない。
'
CCFc-)[Calc]
[ Subtotal of Column ]
CCSbTL-)[Calc]列の小計
Sub CalcSubTotal
Dim oDoc as Object, oSheet as Object, oRange as Object
Dim oUnoObj01 as Object, oUnoObj02 as Object
Dim oDesc as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oRange = oSheet.getCellRangeByName("B1:E5")
' Subtotal Condion of Column 1
oUnoObj01 = CreateUnoStruct("com.sun.star.sheet.SubTotalColumn")
oUnoObj01.Column = 0 ' Column Index / relative Index = B Column
oUnoObj01.Function = com.sun.star.sheet.GeneralFunction.SUM
' Subtotal Condion of Column 2
oUnoObj02 = CreateUnoStruct("com.sun.star.sheet.SubTotalColumn")
oUnoObj02.Column = 3 ' Column Index / relative Index = B Column
oUnoObj02.Function = com.sun.star.sheet.GeneralFunction.SUM
'
oDesc = oRange.createSubTotalDescriptor(True)
oDesc.addNew(Array(oUnoObj01, oUnoObj02), 1) '
oDesc.BindFormatsToContent = False
'
oRange.applySubTotals(oDesc, True)
msgbox "Success"
End Sub
'
' [ Note ]
' 1) ' B列の横に結果を記す
' oDesc.addNew(Array(oUnoObj01, oUnoObj02),1) 第二引数（=1）は結果を示すColumn No.( B列の結果を示す )
CCSbTL-)[Calc]列の小計(2)
Sub CalcSubTotal
Dim oDoc as Object, oSheet as Object, oRange as Object
Dim oUnoObj01 as Object, oUnoObj02 as Object
Dim oDesc as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oRange = oSheet.getCellRangeByName("B1:E5")
' Subtotal Condion of Column 1
oUnoObj01 = CreateUnoStruct("com.sun.star.sheet.SubTotalColumn")
oUnoObj01.Column = 0 ' Column Index / relative Index = B Column
oUnoObj01.Function = com.sun.star.sheet.GeneralFunction.SUM
' Subtotal Condion of Column 2
oUnoObj02 = CreateUnoStruct("com.sun.star.sheet.SubTotalColumn")
oUnoObj02.Column = 3 ' Column Index / relative Index = B Column
oUnoObj02.Function = com.sun.star.sheet.GeneralFunction.SUM
'
oDesc = oRange.createSubTotalDescriptor(True)
oDesc.addNew(Array(oUnoObj01, oUnoObj02), 4) '
oDesc.BindFormatsToContent = False
'
oRange.applySubTotals(oDesc, True)
msgbox "Success"
End Sub
' [Note ]
' oDesc.addNew(Array(oUnoObj01, oUnoObj02),4)
' 選択範囲の最終列(E列)に第二引数にすると表示が違う？
CCSbTL-)[Calc]Subtotal Dialog表示
Sub UnoSubTotal()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' 範囲を指定した列のみ、Dialogに候補に表示される。
oProp(0).Name = "ToPoint"
oProp(0).Value = "B1:D5"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:DataSubTotals", "", 0, Array())
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
CCSbTL-)[Calc]
[ 入力値規則 ]
CCVS-)[Calc]入力値を1～10に限定する
Sub SetValidationRange()
Dim oRange as Object
Dim oValidation as Object
Dim oSheets as Object
oSheets = ThisComponent.getSheets().getByName("sheet1")
oRange = oSheets.getCellRangeByName("A1:D10")
oValidation = oRange.Validation
oValidation.Type = com.sun.star.sheet.ValidationType.DECIMAL
oValidation.ErrorMessage = "Please enter a number between 1 to 10"
ovalidation.ShowErrorMessage = true
oValidation.ErrorAlertStyle = com.sun.star.sheet.ValidationAlertStyle.STOP
oValidation.setOperator(com.sun.star.sheet.ConditionOperator.BETWEEN)
'
oValidation.setFormula1(1.0)
oValidation.setFormula1(10,0)
'
oRange.Validation = oValidation
msgbox "Success"
End Sub
'
'com.sun.star.sheet.TableValidation Service
' Type : Validation Type
' ShowInputMessage : True => Input Message表示
' InputTitle : Input MessageのTitel指定
' InputMessage : Input Messageの表示文
' ShowErrorMessage : true => Error Message表示
' ErrorTitle : Error MessageのTitel指定
' ErrorMessage : Eroor Messageの表示文
' IgnoreBlankCells : true => Blank OKとする。
' ErrorAlertStyle : Error Message後の処理方法
’Type
'com.sun.star.sheet.ValidationType enum( LibreOffice / ApacheOpenOffice )
' com.sun.star.sheet.ValidationTYPE.ANY : 全て拒否
' com.sun.star.sheet.ValidationTYPE.WHOLE : 整数のみOK
' com.sun.star.sheet.ValidationTYPE.DECIMAL : 特定の値のみOK
' com.sun.star.sheet.ValidationTYPE.DATE : 日付のみOK
' com.sun.star.sheet.ValidationTYPE.TIME : 時間のみOK
' com.sun.star.sheet.ValidationTYPE.TEXT_LEN : 既定長さ内の文字列OK
' com.sun.star.sheet.ValidationTYPE.LIST : 文字列LIST
' com.sun.star.sheet.ValidationTYPE.CUSTOM : Custom
'
'com.sun.star.sheet.ValidationAlertStyle enum
' com.sun.star.sheet.ValidationTYPE.STOP : Error Messege後入力値消去。
' com.sun.star.sheet.ValidationTYPE.WARNING : Warning Message。 このまま使用可能。
' com.sun.star.sheet.ValidationTYPE.INFO : Information Message。このまま使用可能。
' com.sun.star.sheet.ValidationTYPE.MACRO : 指定MACRO実行
CCVS-)[Calc]文字列及び0以上の値以外は90°回転表示
Sub oSetConditionalStyle
Dim oSheets
Dim oRange
Dim oConFormat
Dim oCondition(2) as new com.sun.star.beans.PropertyValue
oSheets = ThisComponent.Sheets(3)
oRange = oSheets.getCellRangeByName("A1:D10")
'Obtain the Validation object
oConFormat = oRange.ConditionalFormat
oCondition(0).Name = "Operator"
oCondition(0).Value = com.sun.star.sheet.ConditionOperator.LESS
oCondition(1).Name = "Formula1"
oCondition(1).Value = 0
oCondition(2).Name = "StyleName"
oCondition(2).Value = "Heading1"
oConFormat.addNew(oCondition())
oRange.ConditionalFormat = oConFormat
End Sub
'
'com.sun.star.sheet.ConditionOperator enum
' com.sun.star.sheet.ConditionOperator.NOME : 全てOK
' com.sun.star.sheet.ConditionOperator.EQUAL : 指定値と同じ
' com.sun.star.sheet.ConditionOperator.NOT_EQUAL : 指定値以外
' com.sun.star.sheet.ConditionOperator.GENERATER : 指定値より大きい
' com.sun.star.sheet.ConditionOperator.GENERATER_EQUAL : 指定値以上
' com.sun.star.sheet.ConditionOperator.LESS : 指定値より小さい
' com.sun.star.sheet.ConditionOperator.LESS_EQUAL : 指定値以下
' com.sun.star.sheet.ConditionOperator.BETWEEN : 指定値間
' com.sun.star.sheet.ConditionOperator.NOT_BETWEEN : 指定値間以外
' com.sun.star.sheet.ConditionOperator.FORMULA : 結果が0にならない式
CCVS-)[Calc]条件付き書式Dialog表示(1)[ 条件 ]
Sub CalcConditionFormat()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:ConditionalFormatDialog", "", 0, Array())
End Sub
CCVS-)[Calc]条件付き書式Dialog表示(2)[ ColorScale ]
Sub CalcConditionFormat()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:ColorScaleFormatDialog", "", 0, Array())
End Sub
'
' [ Note ]
' Style名で設定する以外の設定方法については、APIが未対応の模様( LibreOffice4.0.1 )
' ColorScale / Databar / ManagerについてはDialog表示まで。
' 既に ColorScaleのFormatが設定済みの時は 条件 と同じDialogが表示
CCVS-)[Calc]条件付き書式Dialog表示(3)[ DataBar ]
Sub CalcConditionFormat()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:DataBarFormatDialog", "", 0, Array())
End Sub
CCVS-)[Calc]条件付き書式Dialog表示(4)[ 管理 ]
Sub CalcConditionFormat()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:ConditionalFormatManagerDialog", "", 0, Array())
End Sub
CCVS-)[Calc]List入力設定
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
'
msgbox "Success"
End Sub
'
' [ Note ]
' oValidation.Formula1 = Array("NewYork","London","Paris","Tokyo") はError → Only String
' 区切りは Spaceのみ
' """New York"" London Paris Tokyo" → "" で囲っていない場合、全て小文字になる。
CCVS-)[Calc]入力規則Dialog表示
Sub CalcValidation()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oDispatcher.executeDispatch(oFrame, ".uno:Validation", "", 0, Array())
'
msgbox "Success"
End Sub
CCVS-)[Calc]
[ 連続Data / Fill ]
CCCd-)[Calc]右方向に連続Data作成
Sub oFill
Dim oRange
Dim oSheet
Dim oAllData
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:G1")
oSheet.getCellByPosition(0,0).Value=1
oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_RIGHT, 1) ' 2 => 1cell飛ばしで入力 1=>連続
'Get Data
oAllData = oRange.getDataArray()
for i = 0 to UBound(oAllData)
oDisp = join(oAllData(i), " : ")
next i
msgbox(oDisp,0,"連続Data")
oRange.clearContents(com.sun.star.sheet.CellFlags.VALUE)
End Sub
CCCd-)[Calc]左方向に連続Data作成
Sub oFill
Dim oRange
Dim oSheet
Dim oAllData
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:G1")
oSheet.getCellByPosition(6,0).Value=1
oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_LEFT, 2) ' 2 => 1cell飛ばしで入力 1=>連続
'Get Data
oAllData = oRange.getDataArray()
for i = 0 to UBound(oAllData)
oDisp = join(oAllData(i), " : ")
next i
msgbox(oDisp,0,"連続Data")
oRange.clearContents(com.sun.star.sheet.CellFlags.VALUE)
End Sub
CCCd-)[Calc]上方向に連続Data作成
Sub oFill
Dim oRange
Dim oSheet
Dim oAllData
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:A10")
oSheet.getCellByPosition(0,9).Value=1
oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_TOP, 1 ) ' 2 => 1cell飛ばしで入力 1=>連続
'Get Data
oAllData = oRange.getDataArray()
for i = 0 to UBound(oAllData)
oDisp = oDisp & join(oAllData(i) ) & Chr$(10)
next i
msgbox(oDisp,0,"連続Data")
oRange.clearContents(com.sun.star.sheet.CellFlags.VALUE)
End Sub
CCCd-)[Calc]下方向に連続Data作成1
Sub SetFillData()
Dim oDoc as Object, oSheet as Object
Dim oRange as Object
Dim oAllData() as Variant
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oRange = oSheet.getCellRangeByName("A1:C10")
oSheet.getCellByPosition(0,0).Value = 1 ' 値
' 日付、時刻 / Serial値で無いと月や分が変わらない / Cell Formatは事前に設定
oSheet.getCellByPosition(1,0).Value = DateSerial(2012,12,29)
oSheet.getCellByPosition(2,0).Value = TimeSerial(12,24,56)
oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, 2 )
'Get Data
oAllData = oRange.getDataArray()
for i = 0 to UBound(oAllData)
oDisp = oDisp & join(oAllData(i)," → ") & Chr$(10)
next i
msgbox(oDisp,0,"連続Data")
'
' DataのClear
Dim oFlag as Long
' VALUE, DATETIMEの削除
oFlag = com.sun.star.sheet.CellFlags.VALUE + com.sun.star.sheet.CellFlags.DATETIME
oRange.clearContents(oFlag)
End Sub
'
' [ Note ]
' .fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, 2 ) ' 2 → Cell Addressの増分値
CCCd-)[Calc]下方向に連続Data作成2-1(足し算)
Sub SetFillData()
Dim oDoc as Object, oSheet as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp1(0) as new com.sun.star.beans.PropertyValue
Dim oProp(5) as new com.sun.star.beans.PropertyValue
Dim oStep as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' Cell Formatは事前に設定
oSheet.getCellByPosition(0,0).Value = 1
oSheet.getCellByPosition(1,0).Value = DateSerial(2012,12,29)
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp1(0).Name = "ToPoint"
oProp1(0).Value = "$A$1:$B$10"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
'
oProp(0).Name = "FillDir"
oProp(0).Value = "B"
oProp(1).Name = "FillCmd"
oProp(1).Value = "L"
oProp(2).Name = "FillStep"
oProp(2).Value = "2"
oProp(3).Name = "FillDateCmd"
oProp(3).Value = "D"
oProp(4).Name = "FillStart"
oProp(4).Value = ""
oProp(5).Name = "FillMax"
oProp(5).Value = "1.70000000E+307"
oDispatcher.executeDispatch(oFrame, ".uno:FillSeries", "", 0, oProp())
'
msgbox "Success"
End Sub
'
' [ Note ]
' 0) FillDir : 方向
' B : 上から下へ / T : 下から上へ / R : 左から右へ / L : 右から左へ
' 1) FillCmd : 連続Dataの種類
' L : 足し算 / G : 掛け算 / D : 日付 / A : AutoFill
' 日付Dataが含まれている時は G : 掛け算 不可
' 2) FillStep : 増分
' 3) FillDateCmd : 日付の単位
' Y : Year / M : Month / D : Day / W : WeekDay( FillCmd が D or L の時のみ利用可能 )
' 4) FillStart : 開始値
' 複数の列の連続Dataを作成する際、macro の 記録では "1.70000000E+307"となるが、空白に修正しないと左端の列は "1.70000000E+307"に置き換わってしまう
' 5) FillMax : 停止値
' "1.70000000E+307"は設定無しと同じ
CCCd-)[Calc]下方向に連続Data作成2-2(掛け算)
Sub SetFillData()
Dim oDoc as Object, oSheet as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp1(0) as new com.sun.star.beans.PropertyValue
Dim oProp(5) as new com.sun.star.beans.PropertyValue
Dim oStep as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' Cell Formatは事前に設定
oSheet.getCellByPosition(0,0).Value = 1
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp1(0).Name = "ToPoint"
oProp1(0).Value = "$A$1:$A$10"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
'
oProp(0).Name = "FillDir"
oProp(0).Value = "B"
oProp(1).Name = "FillCmd"
oProp(1).Value = "G"
oProp(2).Name = "FillStep"
oProp(2).Value = "5"
oProp(3).Name = "FillDateCmd"
oProp(3).Value = ""
oProp(4).Name = "FillStart"
oProp(4).Value = ""
oProp(5).Name = "FillMax"
oProp(5).Value = "1.70000000E+307"
oDispatcher.executeDispatch(oFrame, ".uno:FillSeries", "", 0, oProp())
'
msgbox "Success"
End Sub
CCCd-)[Calc]下方向に連続Data作成2-3(Weekday)
Sub SetFillData()
Dim oDoc as Object, oSheet as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp1(0) as new com.sun.star.beans.PropertyValue
Dim oProp(5) as new com.sun.star.beans.PropertyValue
Dim oStep as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' Cell Formatは事前に設定
oSheet.getCellByPosition(1,0).Value = DateSerial(2012,12,28)
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp1(0).Name = "ToPoint"
oProp1(0).Value = "$B$1:$B$10"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
'
oProp(0).Name = "FillDir"
oProp(0).Value = "B"
oProp(1).Name = "FillCmd"
oProp(1).Value = "D" ' ← D or L のみ
oProp(2).Name = "FillStep"
oProp(2).Value = "4"
oProp(3).Name = "FillDateCmd"
oProp(3).Value = "W"
oProp(4).Name = "FillStart"
oProp(4).Value = ""
oProp(5).Name = "FillMax"
oProp(5).Value = "1.70000000E+307"
oDispatcher.executeDispatch(oFrame, ".uno:FillSeries", "", 0, oProp())
'
msgbox "Success"
End Sub
CCCd-)[Calc]下方向に連続Data作成2-4(AutoFill)
Sub SetFillData()
Dim oDoc as Object, oSheet as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp1(0) as new com.sun.star.beans.PropertyValue
Dim oProp(5) as new com.sun.star.beans.PropertyValue
Dim oStep as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' Cell Formatは事前に設定
oSheet.getCellByPosition(0,0).String = "1月"
oSheet.getCellByPosition(0,1).String = "3月"
oSheet.getCellByPosition(1,0).String = "10年"
oSheet.getCellByPosition(1,1).String = "20年"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp1(0).Name = "ToPoint"
oProp1(0).Value = "$A$1:$B$6"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
'
oProp(0).Name = "FillDir"
oProp(0).Value = "B"
oProp(1).Name = "FillCmd"
oProp(1).Value = "A"
oProp(2).Name = "FillStep"
oProp(2).Value = "" ' ← AutoFill 時は 設定不可
oProp(3).Name = "FillDateCmd"
oProp(3).Value = ""
oProp(4).Name = "FillStart"
oProp(4).Value = ""
oProp(5).Name = "FillMax"
oProp(5).Value = "1.70000000E+307"
oDispatcher.executeDispatch(oFrame, ".uno:FillSeries", "", 0, oProp())
'
msgbox "Success"
End Sub
CCCd-)[Calc]下方向に連続Data作成2-5(上限を付けて)
Sub SetFillData()
Dim oDoc as Object, oSheet as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp1(0) as new com.sun.star.beans.PropertyValue
Dim oProp(5) as new com.sun.star.beans.PropertyValue
Dim oStep as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' Cell Formatは事前に設定
oSheet.getCellByPosition(0,0).Value = 3
oSheet.getCellByPosition(1,0).String = 5
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp1(0).Name = "ToPoint"
oProp1(0).Value = "$A$1:$B$7"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
'
oProp(0).Name = "FillDir"
oProp(0).Value = "B"
oProp(1).Name = "FillCmd"
oProp(1).Value = "G"
oProp(2).Name = "FillStep"
oProp(2).Value = "2"
oProp(3).Name = "FillDateCmd"
oProp(3).Value = ""
oProp(4).Name = "FillStart"
oProp(4).Value = ""
oProp(5).Name = "FillMax"
oProp(5).Value = "100"
oDispatcher.executeDispatch(oFrame, ".uno:FillSeries", "", 0, oProp())
'
msgbox "Success"
End Sub
CCCd-)[Calc]Table Operation1
Sub oMultipleOpsColumns
Dim oRange
Dim oSheet
Dim oCell
Dim oBlockAddress
Dim oCellAddress
oSheet = ThisComponent.Sheets(1)
'Set the topmost Value
oCell = oSheet.getCellByPosition(0,9)
oCell.setValue(0)
'Fill the Values Down! for 0 to about 6.4
oRange = oSheet.getCellRangeByName("A10:A73")
oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, _
com.sun.star.sheet.FillMode.LINEAR, _
com.sun.star.sheet.FillDateMode.FILL_DATE_DAY, 0.1, 6.4)
'Setting the Sin() and Cos() Header Values
oCell = oSheet.getCellByPosition(1,8)
oCell.setString("Sin()")
oCell = oSheet.getCellByPosition(2,8)
oCell.setString("Cos()")
'Setting the Sin() and Cos() Formulas
oCell = oSheet.getCellByPosition(1,9)
oCell.setFormula("Sin(A10)")
oCell = oSheet.getCellByPosition(2,9)
oCell.setFormula("Cos(A10)")
'Set Range
oRange = oSheet.getCellRangeByName("A11:C73")
'Get Address to copy
oBlockAddress = oSheet.getCellRangeByName("B10:C10").getRangeAddress()
'Column Address
oCellAddress = oSheet.getCellByPosition(0,9).getCellAddress()
'
oRange.setTableOperation(oBlockAddress, _
com.sun.star.sheet.TableOperationMode.COLUMN , oCellAddress, oCellAddress)
'
End Sub
'
' [ com.sun.star.sheet.FillDateMode enum( LibreOffice / Apache OpenOffice ]
' com.sun.star.sheet.FillDateMode.FILL_DATE_DAY
' com.sun.star.sheet.FillDateMode.FILL_DATE_WEEKDAY
' com.sun.star.sheet.FillDateMode.FILL_DATE_MONTH
' com.sun.star.sheet.FillDateMode.FILL_DATE_YEAR
'
'
CCCd-)[Calc]Table Operation2
Sub oMultipleOpsColumns
Dim oRange
Dim oSheet
Dim oCell
Dim oBlockAddress
Dim oCellAddress
oSheet = ThisComponent.Sheets(1)
'Set the Row Values of constant values
oRowCell = oSheet.getCellByPosition(1,9)
oRowCell.setValue(1)
oRange = oSheet.getCellRangeByName("B10:K10")
oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_RIGHT, 1)
'Set the Column Values of constant values
oColCell = oSheet.getCellByPosition(0,10)
oColCell.setValue(1)
oRange = oSheet.getCellRangeByName("A11:A20")
oRange.fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, 1)
'Set the first formula and Value
oCell = oSheet.getCellByPosition(0, 9)
oCell.setFormula("=A11*B10")
'Get Range of the Cells
oRange = oSheet.getCellRangeByName("A10:K20")
'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())
End Sub
CCCd-)[Calc]右方向に同じ値を入力
Sub SetFillData()
Dim oDoc as Object, oSheet as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp1(0) as new com.sun.star.beans.PropertyValue
Dim oProp(0) as new com.sun.star.beans.PropertyValue
Dim oStep as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' Cell Formatは事前に設定
oSheet.getCellByPosition(0,0).Value = 1
oSheet.getCellByPosition(0,1).Value = DateSerial(2012,1,1)
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp1(0).Name = "ToPoint"
oProp1(0).Value = "$A$1:$D$2"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
oDispatcher.executeDispatch(oFrame, ".uno:FillRight", "", 0, oProp())
'
msgbox "Success"
End Sub
CCCd-)[Calc]左方向に同じ値を入力
Sub SetFillData()
Dim oDoc as Object, oSheet as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp1(0) as new com.sun.star.beans.PropertyValue
Dim oProp(0) as new com.sun.star.beans.PropertyValue
Dim oStep as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' Cell Formatは事前に設定
oSheet.getCellByPosition(3,0).String = "Left"
oSheet.getCellByPosition(3,1).Value = DateSerial(2012,2,3)
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp1(0).Name = "ToPoint"
oProp1(0).Value = "$A$1:$D$2"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
oDispatcher.executeDispatch(oFrame, ".uno:FillLeft", "", 0, oProp())
'
msgbox "Success"
End Sub
CCCd-)[Calc]上方向に同じ値を入力
Sub SetFillData()
Dim oDoc as Object, oSheet as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp1(0) as new com.sun.star.beans.PropertyValue
Dim oProp(0) as new com.sun.star.beans.PropertyValue
Dim oStep as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' Cell Formatは事前に設定
oSheet.getCellByPosition(0,4).String = "Up"
oSheet.getCellByPosition(1,4).Value = DateSerial(2012,3,1)
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp1(0).Name = "ToPoint"
oProp1(0).Value = "$A$1:$B$5"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
oDispatcher.executeDispatch(oFrame, ".uno:FillUp", "", 0, oProp())
'
msgbox "Success"
End Sub
CCCd-)[Calc]下方向に同じ値を入力
Sub SetFillData()
Dim oDoc as Object, oSheet as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp1(0) as new com.sun.star.beans.PropertyValue
Dim oProp(0) as new com.sun.star.beans.PropertyValue
Dim oStep as Integer
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' Cell Formatは事前に設定
oSheet.getCellByPosition(0,0).String = "Down"
oSheet.getCellByPosition(1,0).Value = DateSerial(2012,4,3)
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
oProp1(0).Name = "ToPoint"
oProp1(0).Value = "$A$1:$B$5"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp1())
oDispatcher.executeDispatch(oFrame, ".uno:FillDown", "", 0, oProp())
'
msgbox "Success"
End Sub
[ Recalcuation( 再計算 ) ]
CCRC-)[Calc]再計算[ Key F9 ](1)
Sub oCalcReCalculation()
Dim oDoc as Object
oDoc = ThisComponent
' ReCalculation
oDoc.calculateAll()
'
msgbox "Success"
End Sub
'
' [ 注意事項 ]
1) Default では図の 「ツール」→「セルの内容」→「自動計算」にCheckが入っているので、
Macroの効果を確認する為には事前にCheckを外しておく。
CCRC-)[Calc]再計算[ Key F9 ](2)
Sub oCalcReCalculation()
Dim oDoc as Object
oDoc = ThisComponent
' ReCalculation
Dim oFrame as Object
Dim oDispacher as Object
oFrame = oDoc.CurrentController.Frame
oDispacher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispacher.executeDispatch(oFrame, ".uno:Calculate", "", 0, Array())
oDoc.calculateAll()
'
msgbox "Success"
End Sub
CCRC-)[Calc]無条件の再計算[ Key Ctrl+Shift+F9 ](1)
Sub CalcReCalculation()
Dim oDoc as Object
oDoc = ThisComponent
' ReCalculation
oDoc.calculate()
'
msgbox "Success"
End Sub
CCRC-)[Calc]無条件の再計算[ Key Ctrl+Shift+F9 ](2)
Sub oCalcReCalculation()
Dim oDoc as Object
oDoc = ThisComponent
' ReCalculation
Dim oFrame as Object
Dim oDispacher as Object
oFrame = oDoc.CurrentController.Frame
oDispacher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispacher.executeDispatch(oFrame, ".uno:CalculateHard", "", 0, Array())
'
msgbox "Success"
End Sub
CCRC-)[Calc]自動計算のToggleのON / OFF設定
Sub oCalcReCalculation()
Dim oDoc as Object
oDoc = ThisComponent
' ReCalculation
Dim oFrame as Object
Dim oDispacher as Object
oFrame = oDoc.CurrentController.Frame
oDispacher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispacher.executeDispatch(oFrame, ".uno:AutomaticCalculation", "", 0, Array())
'
oDisp = "自動計算の設定を変更しました。" & Chr$(10) & _
" ON → OFF 又は OFF → ON"
msgbox oDisp,0,"自動計算の設定"
End Sub
CCRC-)[Calc]自動計算のToggleのON / OFF設定と確認
Sub CalcCalculation()
Dim oDoc as Object
Dim oChkCalc as Boolean
Dim oDisp as String
oDoc = ThisComponent
' Check Automatic Calculation( Before )
oChkCalc = oDoc.IsAutomaticCalculationEnabled()
'
oDisp = "[ 自動計算ON/OFF ]" & Chr$(10) & "Before : " & oChkCalc
'
' Change Setting of Automatic Calculation
oDoc.enableautomaticCalculation( false ) ' true : ON / false : OFF
msgbox "自動計算をOFFにしました。"
'
oChkCalc = oDoc.IsAutomaticCalculationEnabled()
oDisp = oDisp & Chr$(10) & "After : " & oChkCalc
'
msgbox oDisp,0,"自動計算"
End Sub
[ Tokens ]
CCTkn-)[Calc]FormulaToken
Sub CalcTokens()
Dim oDoc as Object
Dim oSheet as Object
Dim oCell as Object
Dim oToken as Object
Dim oDisp as String
Dim oTokenStr as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,2)
'
oToken = oCell.getTokens()
'
oDisp = CStr(oCell.Formula) & Chr$(10) & Chr$(10)
for i = 0 to UBound(oToken)
select case oToken(i).OpCode
case 0
oTokenStr = "Cell Addess or 数値"
case 8
oTokenStr = "("
case 9
oTokenStr = ")"
case 14
oTokenStr = " " ' 半角Space
case 40
oTokenStr = "+"
case 41
oTokenStr = "-"
case 42
oTokenStr = "*"
case 43
oTokenStr = "/"
case 65
oTokenStr = "PI"
case 82
oTokenStr = "Sin"
case 83
oTokenStr = "Cos"
case 84
oTokenStr = "Tan"
case 224
oTokenStr = "Sum"
case else
oTokenStr = "未登録"
end select
oDisp = oDisp & " " & i + 1 & ") " & oTokenStr & Chr$(10)
next i
msgbox(oDisp,0,"Cell の Tokens")
End Sub
CCTkn-)[Calc]
[ Name Range ]
CCNmRg-)[Calc]Name Range有無確認/削除/設定
Sub CalcNameRange()
Dim oDoc as Object, oSheet as Object
Dim oRange as Object
Dim oRngAbsName as String
Dim oRngName as String
Dim oDocNmRng as Object
Dim oTbCellAdrr as Object
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oRange = oSheet.getCellRangeByName("A2:D6")
oRngAbsName = oRange.AbsoluteName
'
oRngName = "TestName"
'
' 同じRange Nameを付けようとするとCrashするので、同名Range Nameは一旦、削除する
oDocNmRng = oDoc.NamedRanges
If oDocNmRng.hasByName(oRngName) Then
oDocNmRng.removeByName(oRngName)
End If
'
' Rangeの相対Origin設定
oTbCellAdrr = createUnoStruct("com.sun.star.table.CellAddress")
with oTbCellAdrr
.sheet = 0
.column = 0
.row = 0
end with
' Name Range設定
oDocNmRng.addNewByName(oRngName, oRngAbsName, oTbCellAdrr, 0 )
'
oDisp = "Name Range : " & oRngName & Chr$(10) & " Exist ? → " & oDocNmRng.hasByName(oRngName)
msgbox oDisp,0,"Name Range"
End Sub
'
' [ Note ]
' com.sun.star.sheet.XNamedRanges( LibreOffice / Apache OpenOffice )
' Name Ranges( Apache OpenOffice )
' NamedRanges Service Reference( LibreOffice )
'
' constans com.sun.star.sheet.NamedRangeFlag( LibreOffice / Apache OpenOffice )
' 0 : Common name range
' 1 : com.sun.star.sheet.NamedRangeFlag.FILTER_CRITERIA
' 2 : com.sun.star.sheet.NamedRangeFlag.PRINT_AREA
' 4 : com.sun.star.sheet.NamedRangeFlag.COLUMN_HEADER
' 8 : com.sun.star.sheet.NamedRangeFlag.ROW_HEADER
CCNmRg-)[Calc]Title RowからName Range設定
Sub CalcNameRange()
Dim oDoc as Object
Dim oDocNmRng as Object
Dim oEnum as Object
Dim oElmt as Object
Dim oTbRngCellAdrr as Object
Dim oDisp as String
oDoc = ThisComponent
oDocNmRng = oDoc.NamedRanges
'
' 同じRange Nameを付けようとするとCrashするので、一旦、全てのRange Nameを削除する
oEnum = oDocNmRng.createEnumeration()
nn = 0
Do while oEnum.hasMoreElements()
oElmt = oEnum.nextElement()
oDocNmRng.removeByName(oElmt.Name)
nn = nn + 1
if nn > 1000 then
Exit Do
End if
Loop
'
' Range設定
oTbRngCellAdrr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oTbRngCellAdrr
.sheet = 0
.StartColumn = 0
.EndColumn = 2
.StartRow = 0
.EndRow = 4
end with
' Name Range設定 / Title行取得
oDocNmRng.addNewFromTitles(oTbRngCellAdrr, com.sun.star.sheet.Border.TOP )
'
oDisp = "[ Name Range ]"
oEnum = oDocNmRng.createEnumeration()
nn = 0
Do while oEnum.hasMoreElements()
oElmt = oEnum.nextElement()
oDisp = oDisp & Chr$(10) & oElmt.Name
nn = nn + 1
if nn > 1000 then
Exit Do
End if
Loop
msgbox oDisp,0,"Name Range"
End Sub
CCNmRg-)[Calc]Name Range出力
Sub CalcNameRange()
Dim oDoc as Object
Dim oDocNmRng as Object
Dim oEnum as Object
Dim oElmt as Object
Dim oTbRngCellAdrr as Object
Dim oTbCellAddr as Object
Dim oDisp as String
oDoc = ThisComponent
oDocNmRng = oDoc.NamedRanges
'
oEnum = oDocNmRng.createEnumeration()
nn = 0
Do while oEnum.hasMoreElements()
oElmt = oEnum.nextElement()
oDocNmRng.removeByName(oElmt.Name)
nn = nn + 1
if nn > 1000 then
Exit Do
End if
Loop
'
' Range設定
oTbRngCellAdrr = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oTbRngCellAdrr
.sheet = 0
.StartColumn = 0
.EndColumn = 2
.StartRow = 0
.EndRow = 4
end with
' Name Range設定 / Title行取得
oDocNmRng.addNewFromTitles(oTbRngCellAdrr, com.sun.star.sheet.Border.TOP )
'
oTbCellAddr = createUnoStruct("com.sun.star.table.CellAddress")
with oTbCellAddr
.sheet = 0
.Column = 0
.Row = 6
end with
'
' output先Cell のFormatを Text設定
Dim NumberFormats As Object
Dim NumberFormatString As String
Dim NumberFormatId As Long
Dim LocalSettings As New com.sun.star.lang.Locale
oSheet = oDoc.getSheets().getByIndex(0)
oOutRng = oSheet.getCellRangeByname("A7:B9")
NumberFormats = oDoc.NumberFormats
NumberFormatString = "@"
NumberFormatId = NumberFormats.queryKey(NumberFormatString, LocalSettings, True)
'
NumberFormatId = NumberFormats.queryKey(NumberFormatString, LocalSettings, True)
If NumberFormatId = -1 Then
NumberFormatId = NumberFormats.addNew(NumberFormatString, LocalSettings) '書式コードを追加
End If
oOutRng.NumberFormat = NumberFormatId
'
' Output Name Range
oDocNmRng.outputList(oTbCellAddr)
'
msgbox "Success",0,"Name Range"
End Sub
CCNmRg-)[Calc]
Query
CCQ-)[Calc]空白以外のCell Address抽出1
Sub oNonEmptyCellsinRange
Dim oSheet
Dim oRange
Dim oCell
Dim orangeQuery
Dim oAddress()
Dim oAd
Dim i as Long
Dim nRow as Long
Dim nCol as Long
oSheets = ThisComponent.Sheets(1)
oRange = oSheets.getCellRangeByName("A1:G20")
oRangeQuery =oRange.queryContentCells(com.sun.star.sheet.CellFlags.VALUE OR _
com.sun.star.sheet.CellFlags.DATETIME OR _
com.sun.star.sheet.CellFlags.STRING OR _
com.sun.star.sheet.CellFlags.FORMULA)
oAddress() = oRangeQuery.getRangeAddresses()
for i = 0 to UBound(oAddress())
oAd = oAddress(i)
for nRow = oAddress(i).StartRow to oAddress(i).EndRow
for nCol = oAddress(i).StartColumn to oAddress(i).EndColumn
oCell = oRange.Spreadsheet.getCellByPosition(nCol,nRow)
oDisp = oDisp & PrintableAddressOfCell(oCell) & Chr$(10)
next nCol
next nRow
next i
msgbox(oDisp,0,"")
End Sub
'[ Function1 ]
Function PrintableAddressOfCell(oCell) as String
If IsNull(oCell) OR IsEmpty(oCell) then
PrintableAddressOfCell = "Unknown"
else
PrintableAddressOfCell =oCell.getSpreadSheet().getName & " : " & _
ColumnNumberToString(oCell.CellAddress.Column) & _
CStr(oCell.CellAddress.Row+1)
End If
End Function
'
'[ Function2 ]
Function ColumnNumberToString(ByVal nColumn As Long) as String
Dim oReturn2 as String
Do While nColumn>=0
oReturn2= Chr$(65+ (nColumn MOD 26)) & oReturn2
nColumn= nColumn / 26 -1
Loop
ColumnNumberToString = oReturn2
End Function
CCQ-)[Calc]空白以外のCell Address抽出2
Sub oTraverseRows
Dim oSheet
Dim oRange
Dim oRangeRow
Dim oRow
Dim oRowEnum
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:G20")
oRangeRow = oRange.getRows()
oRowEnum = oRangeRow.createEnumeration()
Do While oRowEnum.hasMoreElements()
oRow = oRowEnum.nextElement()
oDisp = oDisp & oNonEmptyCellsInRange(oRow," ") & Chr$(10)
Loop
Msgbox(oDisp,0,"Non-Empty Cell In Row")
End Sub
'[ Function1 ]
Function oNonEmptyCellsinRange(oRange, sep$)
Dim oCell
Dim orangeQuery
Dim oAddress()
Dim oAd
Dim i as Long
Dim nRow as Long
Dim nCol as Long
oRangeQuery =oRange.queryContentCells(com.sun.star.sheet.CellFlags.VALUE OR _
com.sun.star.sheet.CellFlags.DATETIME OR _
com.sun.star.sheet.CellFlags.STRING OR _
com.sun.star.sheet.CellFlags.FORMULA)
oAddress() = oRangeQuery.getRangeAddresses()
for i = 0 to UBound(oAddress())
oAd = oAddress(i)
for nRow = oAddress(i).StartRow to oAddress(i).EndRow
for nCol = oAddress(i).StartColumn to oAddress(i).EndColumn
oCell = oRange.Spreadsheet.getCellByPosition(nCol,nRow)
oDisp = oDisp & PrintableAddressOfCell(oCell) & sep$
next nCol
next nRow
next i
oNonEmptyCellsinRange = oDisp
End Function
'[ Function2 ]
Function PrintableAddressOfCell(oCell) as String
If IsNull(oCell) OR IsEmpty(oCell) then
PrintableAddressOfCell = "Unknown"
else
PrintableAddressOfCell =oCell.getSpreadSheet().getName & " : " & _
ColumnNumberToString(oCell.CellAddress.Column) & _
CStr(oCell.CellAddress.Row+1)
End If
End Function
'
'[ Function3 ]
Function ColumnNumberToString(ByVal nColumn As Long) as String
Dim oReturn2 as String
Do While nColumn>=0
oReturn2= Chr$(65+ (nColumn MOD 26)) & oReturn2
nColumn= nColumn / 26 -1
Loop
ColumnNumberToString = oReturn2
End Function
CCQ-)[Calc]空白のCell Address取得
Sub QueryEmpCellRange()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oRange as Object
Dim oEmptyCellObj as Object
Dim oCellAddr as Object
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
for i = 0 to 3
for k = 0 to 5
oCell = oSheet.getCellByPosition( i, k )
if k = 2 or k = 3 or k = 4 then
if i = 1 then
' Empty
else
oCell.String = CStr("A" & i + k)
end if
else
oCell.String = CStr( i * k )
end if
next k
next i
'
' EmptyCell Object取得
oRange = oSheet.getCellRangeByName("A1:D6")
oEmptyCellObj = oRange.queryEmptyCells()
'
oDisp = "[ Address of Empty Cell ]" & Chr$(10) & " Addresses of Empty Cell " & Chr$(10) & " ↓"
oCellAddr = oEmptyCellObj.getRangeAddresses()
'
for i = 0 to UBound(oCellAddr)
for j = oCellAddr(i).StartColumn to oCellAddr(i).EndColumn
for k = oCellAddr(i).StartRow to oCellAddr(i).EndRow
oDisp = oDisp & Chr$(10) & "( " & j & ", " & k & " )"
next k
next j
next i
msgbox oDisp,0,"Empty Cell"
End Sub
CCQ-)[Calc]指定範囲内でC2:C6に関連するCell Addrss取得1
Sub oQueryRange
Dim oCell
Dim oCellAddress
Dim oRange
Dim oSheet
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:G20")
'CLear
oClearFlag = com.sun.star.sheet.CellFlags.VALUE OR _
com.sun.star.sheet.CellFlags.DATETIME OR _
com.sun.star.sheet.CellFlags.STRING OR _
com.sun.star.sheet.CellFlags.ANNOTATION OR _
com.sun.star.sheet.CellFlags.FORMULA OR _
com.sun.star.sheet.CellFlags.HARDATTR OR _
com.sun.star.sheet.CellFlags.STYLES OR _
com.sun.star.sheet.CellFlags.OBJECTS OR _
com.sun.star.sheet.CellFlags.EDITATTR
oRange.clearContents(oClearFlag)
'Value Input
for i= 1 to 5
oCell = oSheet.getCellByPosition(1,i)
oCell.setValue( i )
oCell = oSheet.getCellByPosition(2,i)
oCell.setFormula ( "=B" & CStr(i+1) & " + 1")
oCell = oSheet.getCellByPosition(3,i)
oCell.setFormula ( "=C" & CStr(i+1) & " - 1")
next i
oCell = oSheet.getCellByPosition(1,6)
oCell.setFormula ( "=SUM(B2:B5)")
oCell = oSheet.getCellByPosition(2,6)
oCell.setFormula ( "=SUM(C2:C6)")
oCell = oSheet.getCellByPosition(2,0)
oCell.setFormula ( "=B1 - 1")
oCell = oSheet.getCellByPosition(1,0)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(1,7)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(4,2)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(4,7)
oCell.setValue(2)
'queryPrecedents
oCell = oSheet.getCellRangeByName("C2:C6")
oDisp = oDisp & "oCell.queryPredents(false).getRangeAddressesAsString() => " & _
oCell.queryPrecedents(false).getRangeAddressesAsString() & Chr$(10)
oDisp = oDisp & Chr$(10)
Msgbox(oDisp,0,"Manipulating A Range")
End Sub
CCQ-)[Calc]指定範囲内でC2:C6に関連するCell Addrss取得2
Sub oQueryRange
Dim oCell
Dim oCellAddress
Dim oRange
Dim oSheet
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:G20")
'CLear
oClearFlag = com.sun.star.sheet.CellFlags.VALUE OR _
com.sun.star.sheet.CellFlags.DATETIME OR _
com.sun.star.sheet.CellFlags.STRING OR _
com.sun.star.sheet.CellFlags.ANNOTATION OR _
com.sun.star.sheet.CellFlags.FORMULA OR _
com.sun.star.sheet.CellFlags.HARDATTR OR _
com.sun.star.sheet.CellFlags.STYLES OR _
com.sun.star.sheet.CellFlags.OBJECTS OR _
com.sun.star.sheet.CellFlags.EDITATTR
oRange.clearContents(oClearFlag)
'Value Input
for i= 1 to 5
oCell = oSheet.getCellByPosition(1,i)
oCell.setValue( i )
oCell = oSheet.getCellByPosition(2,i)
oCell.setFormula ( "=B" & CStr(i+1) & " + 1")
oCell = oSheet.getCellByPosition(3,i)
oCell.setFormula ( "=C" & CStr(i+1) & " - 1")
next i
oCell = oSheet.getCellByPosition(1,6)
oCell.setFormula ( "=SUM(B2:B5)")
oCell = oSheet.getCellByPosition(2,6)
oCell.setFormula ( "=SUM(C2:C6)")
oCell = oSheet.getCellByPosition(2,0)
oCell.setFormula ( "=B1 - 1")
oCell = oSheet.getCellByPosition(1,0)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(1,7)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(4,2)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(4,7)
oCell.setValue(2)
'queryPrecedents
oCell = oSheet.getCellRangeByName("C2:C6")
oDisp = oDisp & "oCell.queryPredents(true).getRangeAddressesAsString() => " & _
oCell.queryPrecedents(true).getRangeAddressesAsString() & Chr$(10)
oDisp = oDisp & Chr$(10) & Chr$(10)
Msgbox(oDisp,0,"Manipulating A Range")
End Sub
CCQ-)[Calc]指定範囲内でB3に依存するCell Addrss取得
Sub oQueryRange
Dim oCell
Dim oCellAddress
Dim oRange
Dim oSheet
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:G20")
'CLear
oClearFlag = com.sun.star.sheet.CellFlags.VALUE OR _
com.sun.star.sheet.CellFlags.DATETIME OR _
com.sun.star.sheet.CellFlags.STRING OR _
com.sun.star.sheet.CellFlags.ANNOTATION OR _
com.sun.star.sheet.CellFlags.FORMULA OR _
com.sun.star.sheet.CellFlags.HARDATTR OR _
com.sun.star.sheet.CellFlags.STYLES OR _
com.sun.star.sheet.CellFlags.OBJECTS OR _
com.sun.star.sheet.CellFlags.EDITATTR
oRange.clearContents(oClearFlag)
'Value Input
for i= 1 to 5
oCell = oSheet.getCellByPosition(1,i)
oCell.setValue( i )
oCell = oSheet.getCellByPosition(2,i)
oCell.setFormula ( "=B" & CStr(i+1) & " + 1")
oCell = oSheet.getCellByPosition(3,i)
oCell.setFormula ( "=C" & CStr(i+1) & " - 1")
next i
oCell = oSheet.getCellByPosition(1,6)
oCell.setFormula ( "=SUM(B2:B5)")
oCell = oSheet.getCellByPosition(2,6)
oCell.setFormula ( "=SUM(C2:C6)")
oCell = oSheet.getCellByPosition(2,0)
oCell.setFormula ( "=B1 - 1")
oCell = oSheet.getCellByPosition(1,0)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(1,7)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(4,2)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(4,7)
oCell.setValue(2)
'
oCell = oSheet.getCellByPosition(1,2)
oDisp = oDisp & "oCell.queryDependents(true).getRangeAddressesAsString() => " & _
oCell.queryDependents(true).getRangeAddressesAsString() & Chr$(10)
'
oDisp = oDisp & Chr$(10) & Chr$(10)
Msgbox(oDisp,0,"Manipulating A Range")
End Sub
CCQ-)[Calc]指定範囲内でB3と値が異なるCellAddress取得1
Sub oQueryRange
Dim oCell
Dim oCellAddress
Dim oRange
Dim oSheet
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:G20")
'CLear
oClearFlag = com.sun.star.sheet.CellFlags.VALUE OR _
com.sun.star.sheet.CellFlags.DATETIME OR _
com.sun.star.sheet.CellFlags.STRING OR _
com.sun.star.sheet.CellFlags.ANNOTATION OR _
com.sun.star.sheet.CellFlags.FORMULA OR _
com.sun.star.sheet.CellFlags.HARDATTR OR _
com.sun.star.sheet.CellFlags.STYLES OR _
com.sun.star.sheet.CellFlags.OBJECTS OR _
com.sun.star.sheet.CellFlags.EDITATTR
oRange.clearContents(oClearFlag)
'Value Input
for i= 1 to 5
oCell = oSheet.getCellByPosition(1,i)
oCell.setValue( i )
oCell = oSheet.getCellByPosition(2,i)
oCell.setFormula ( "=B" & CStr(i+1) & " + 1")
oCell = oSheet.getCellByPosition(3,i)
oCell.setFormula ( "=C" & CStr(i+1) & " - 1")
next i
oCell = oSheet.getCellByPosition(1,6)
oCell.setFormula ( "=SUM(B2:B5)")
oCell = oSheet.getCellByPosition(2,6)
oCell.setFormula ( "=SUM(C2:C6)")
oCell = oSheet.getCellByPosition(2,0)
oCell.setFormula ( "=B1 - 1")
oCell = oSheet.getCellByPosition(1,0)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(1,7)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(4,2)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(4,7)
oCell.setValue(2)
'queryPrecedents
oCell = oSheet.getCellRangeByName("C2:C6")
oDisp = oDisp & "oCell.queryPredents(false).getRangeAddressesAsString() => " & _
oCell.queryPrecedents(false).getRangeAddressesAsString() & Chr$(10)
oDisp = oDisp & Chr$(10)
oDisp = oDisp & "oCell.queryPredents(true).getRangeAddressesAsString() => " & _
oCell.queryPrecedents(true).getRangeAddressesAsString() & Chr$(10)
oDisp = oDisp & Chr$(10) & Chr$(10)
'
oCell = oSheet.getCellByPosition(1,2)
oDisp = oDisp & "oCell.queryDependents(true).getRangeAddressesAsString() => " & _
oCell.queryDependents(true).getRangeAddressesAsString() & Chr$(10)
'
oDisp = oDisp & Chr$(10) & Chr$(10)
'
oCellAddress = oCell.CellAddress
'queryColumnDifferences / queryRowDifferences
oDisp = oDisp & "[ " & oCell.value & " ]" & Chr$(10)
oDisp = oDisp & "oRange.queryColumnDifferences(oCellAddress).getRangeAddressesAsString() => " & _
oRange.queryColumnDifferences(oCellAddress).getRangeAddressesAsString() & Chr$(10)
oDisp = oDisp & Chr$(10)
Msgbox(oDisp,0,"Manipulating A Range")
End Sub
CCQ-)[Calc]指定範囲内でB3と値が異なるCellAddress取得2
Sub oQueryRange
Dim oCell
Dim oCellAddress
Dim oRange
Dim oSheet
oSheet = ThisComponent.Sheets(1)
oRange = oSheet.getCellRangeByName("A1:G20")
'CLear
oClearFlag = com.sun.star.sheet.CellFlags.VALUE OR _
com.sun.star.sheet.CellFlags.DATETIME OR _
com.sun.star.sheet.CellFlags.STRING OR _
com.sun.star.sheet.CellFlags.ANNOTATION OR _
com.sun.star.sheet.CellFlags.FORMULA OR _
com.sun.star.sheet.CellFlags.HARDATTR OR _
com.sun.star.sheet.CellFlags.STYLES OR _
com.sun.star.sheet.CellFlags.OBJECTS OR _
com.sun.star.sheet.CellFlags.EDITATTR
oRange.clearContents(oClearFlag)
'Value Input
for i= 1 to 5
oCell = oSheet.getCellByPosition(1,i)
oCell.setValue( i )
oCell = oSheet.getCellByPosition(2,i)
oCell.setFormula ( "=B" & CStr(i+1) & " + 1")
oCell = oSheet.getCellByPosition(3,i)
oCell.setFormula ( "=C" & CStr(i+1) & " - 1")
next i
oCell = oSheet.getCellByPosition(1,6)
oCell.setFormula ( "=SUM(B2:B5)")
oCell = oSheet.getCellByPosition(2,6)
oCell.setFormula ( "=SUM(C2:C6)")
oCell = oSheet.getCellByPosition(2,0)
oCell.setFormula ( "=B1 - 1")
oCell = oSheet.getCellByPosition(1,0)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(1,7)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(4,2)
oCell.setValue( 2 )
oCell = oSheet.getCellByPosition(4,7)
oCell.setValue(2)
'queryPrecedents
oCell = oSheet.getCellRangeByName("C2:C6")
oDisp = oDisp & "oCell.queryPredents(false).getRangeAddressesAsString() => " & _
oCell.queryPrecedents(false).getRangeAddressesAsString() & Chr$(10)
oDisp = oDisp & Chr$(10)
oDisp = oDisp & "oCell.queryPredents(true).getRangeAddressesAsString() => " & _
oCell.queryPrecedents(true).getRangeAddressesAsString() & Chr$(10)
oDisp = oDisp & Chr$(10) & Chr$(10)
'
oCell = oSheet.getCellByPosition(1,2)
oDisp = oDisp & "oCell.queryDependents(true).getRangeAddressesAsString() => " & _
oCell.queryDependents(true).getRangeAddressesAsString() & Chr$(10)
'
oDisp = oDisp & Chr$(10) & Chr$(10)
'
oCellAddress = oCell.CellAddress
'queryColumnDifferences / queryRowDifferences
oDisp = oDisp & "[ " & oCell.value & " ]" & Chr$(10)
oDisp = oDisp & "oRange.queryRowDifferences(oCellAddress).getRangeAddressesAsString() => " & _
oRange.queryRowDifferences(oCellAddress).getRangeAddressesAsString()
Msgbox(oDisp,0,"Manipulating A Range")
End Sub
CCQ-)[Calc]２つの範囲で重なる範囲Address取得
Sub QryIntSec()
Dim oDoc as Object, oSheet as Object
Dim oRange as Object
Dim oTbRng as Object
Dim oIntSecObj as Object
Dim oCellAddr as Object
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
'
' 重なる対象範囲 ( com.sun.star.table.CellRangeAddress )
oTbRng = createUnoStruct("com.sun.star.table.CellRangeAddress")
with oTbRng
.Sheet = 0
.StartColumn = 2 ' Col C
.StartRow = 3 ' Row No.4
.EndColumn = 5 ' Col F
.EndRow = 8 ' Row No.8
end with
'
' Intersection Object取得
oRange = oSheet.getCellRangeByName("A1:D6")
oIntSecObj = oRange.queryIntersection(oTbRng)
'
oDisp = "[ Intersection of Range ]" & Chr$(10) & "(A1:D6)と(C4:F9)の重複範囲" & Chr$(10) & " ↓"
oCellAddr = oIntSecObj.getRangeAddresses()
'
for i = 0 to UBound(oCellAddr)
for j = oCellAddr(i).StartColumn to oCellAddr(i).EndColumn
for k = oCellAddr(i).StartRow to oCellAddr(i).EndRow
oDisp = oDisp & Chr$(10) & "( " & j & ", " & k & " )"
next k
next j
next i
msgbox oDisp,0,"Intersection "
End Sub
'
' [ Note ]
' Target Rangeは com.sun.star.table.CellRangeAddress である事に注意。LibreOffice / Apache OpenOffice
CCQ-)[Calc]表示CellのAddress取得
Sub QryVisibleCell()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oRange as Object
Dim oVisibleCellObj as Object
Dim oCellAddr as Object
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
for i = 0 to 3
for k = 0 to 5
oCell = oSheet.getCellByPosition( i, k )
oCell.String = CStr( i * k )
next k
next i
'
' Set InVisible
oSheet.Columns(1).isVisible = false
oSheet.Columns(2).isVisible = false
oSheet.Rows(1).isVisible = false
oSheet.Rows(3).isVisible = false
oSheet.Rows(4).isVisible = false
'
' VisibleCell Object取得
oRange = oSheet.getCellRangeByName("A1:D6")
oVisibleCellObj = oRange.queryVisibleCells()
'
oDisp = "[ Address of Visible Cell ]" & Chr$(10) & "Range = A1:D6 の表示Cell" & Chr$(10) & " ↓"
oCellAddr = oVisibleCellObj.getRangeAddresses()
'
for i = 0 to UBound(oCellAddr)
for j = oCellAddr(i).StartColumn to oCellAddr(i).EndColumn
for k = oCellAddr(i).StartRow to oCellAddr(i).EndRow
oDisp = oDisp & Chr$(10) & "( " & j & ", " & k & " )"
next k
next j
next i
msgbox oDisp,0,"Visible Cell"
End Sub
CCQ-)[Calc]Formula Cell取得
Sub CalcQuery()
Dim oDoc as Object, oSheet as Object
Dim oRange as Object
Dim oFormulaCell as Object
Dim oCells as Object, oEnum as Object, oElmt as Object
Dim oAddrStr as String
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oRange = oSheet.getCellRangeByName("A1:D6")
' Formula Cell取得
oFormulaCell = oRange.queryFormulaCells(1)
' Cell Objectを取得
oCells = oFormulaCell.getCells()
oEnum = oCells.createEnumeration()
nn = 0
oDisp = "[ A1:D6 / Formula Cell ]" & Chr$(10) & "1) VALUE"
Do While oEnum.hasMoreElements()
oElmt = oEnum.nextElement()
oAddrStr = oElmt.AbsoluteName
oDisp = oDisp & Chr$(10) & oAddrStr
nn = nn + 1
if nn > 1000 then
Exit Do
end if
Loop
'
oFormulaCell = oRange.queryFormulaCells(2)
' Cell Objectを取得
oCells = oFormulaCell.getCells()
oEnum = oCells.createEnumeration()
nn = 0
oDisp = oDisp & Chr$(10) & Chr$(10) & "2) STRING"
Do While oEnum.hasMoreElements()
oElmt = oEnum.nextElement()
oAddrStr = oElmt.AbsoluteName
oDisp = oDisp & Chr$(10) & oAddrStr
nn = nn + 1
if nn > 1000 then
Exit Do
end if
Loop
'
oFormulaCell = oRange.queryFormulaCells(4)
' Cell Objectを取得
oCells = oFormulaCell.getCells()
oEnum = oCells.createEnumeration()
nn = 0
oDisp = oDisp & Chr$(10) & Chr$(10) & "3) ERROR"
Do While oEnum.hasMoreElements()
oElmt = oEnum.nextElement()
oAddrStr = oElmt.AbsoluteName
oDisp = oDisp & Chr$(10) & oAddrStr
nn = nn + 1
if nn > 1000 then
Exit Do
end if
Loop
'
oFormulaCell = oRange.queryFormulaCells(2+4)
' Cell Objectを取得
oCells = oFormulaCell.getCells()
oEnum = oCells.createEnumeration()
nn = 0
oDisp = oDisp & Chr$(10) & Chr$(10) & "4) STRING + ERROR"
Do While oEnum.hasMoreElements()
oElmt = oEnum.nextElement()
oAddrStr = oElmt.AbsoluteName
oDisp = oDisp & Chr$(10) & oAddrStr
nn = nn + 1
if nn > 1000 then
Exit Do
end if
Loop
'
msgbox oDisp,0,"Formula Cell / getCells"
End Sub
'
' [ Note ]
' com.sun.star.sheet.FormulaResultLibreOffice / Apache OpenOffice )
' VALUE = 1
' String = 2
' ERROR = 3
' 値はLONG値
CCQ-)[Calc]指定Contents Cell取得
Sub CalcQuery()
Dim oDoc as Object, oSheet as Object
Dim oRange as Object
Dim oFormulaCell as Object
Dim oCells as Object, oEnum as Object, oElmt as Object
Dim oAddrStr as String
Dim oDisp as String
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oRange = oSheet.getCellRangeByName("A1:D6")
' Formula Cell取得
oFormulaCell = oRange.queryContentCells(2)
' Cell Objectを取得
oCells = oFormulaCell.getCells()
oEnum = oCells.createEnumeration()
nn = 0
oDisp = "[ A1:D6 / Content Cell ]" & Chr$(10) & "1) DATETIME"
Do While oEnum.hasMoreElements()
oElmt = oEnum.nextElement()
oAddrStr = oElmt.AbsoluteName
oDisp = oDisp & Chr$(10) & oAddrStr
nn = nn + 1
if nn > 1000 then
Exit Do
end if
Loop
'
oFormulaCell = oRange.queryContentCells(8)
' Cell Objectを取得
oCells = oFormulaCell.getCells()
oEnum = oCells.createEnumeration()
nn = 0
oDisp = oDisp & Chr$(10) & Chr$(10) & "2) ANNOTATION"
Do While oEnum.hasMoreElements()
oElmt = oEnum.nextElement()
oAddrStr = oElmt.AbsoluteName
oDisp = oDisp & Chr$(10) & oAddrStr
nn = nn + 1
if nn > 1000 then
Exit Do
end if
Loop
'
oFormulaCell = oRange.queryContentCells(4+16)
' Cell Objectを取得
oCells = oFormulaCell.getCells()
oEnum = oCells.createEnumeration()
nn = 0
oDisp = oDisp & Chr$(10) & Chr$(10) & "3) STRING + FORMULA"
Do While oEnum.hasMoreElements()
oElmt = oEnum.nextElement()
oAddrStr = oElmt.AbsoluteName
oDisp = oDisp & Chr$(10) & oAddrStr
nn = nn + 1
if nn > 1000 then
Exit Do
end if
Loop
'
msgbox oDisp,0,"Content Cell / getCells"
End Sub
'
' [ Note ]
' com.sun.star.sheet.CellFlags( LibreOffice / Apache OpenOffice )
' ANNOTATION は ANNOTATION削除の時に利用。
CCQ-)[Calc]
