Cell操作
[ Property(Cellの書式設定) ]
{{ Font Effet }}[ Refer to "Font / 文字関連の Property 一覧" ]
{{ Position / Size }}
{{ BorderLine }}
{{ Protection }}
{{ Color }}
{{ autoFormat }}
{{ Annotation( Comment ) }}
[ Claer(内容の削除) ]
[ Selection ]
[ Address(セル番地) ]
Cell操作
[ Property(Cellの書式設定) ]
{{ Font Effet }}
Sub CalcUnderLine()
Dim oDoc As Object, oSheet as Object
Dim oCell(18) as Object
oDoc=ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
for i=0 to 9
oCell(i) = oSheet.getCellByPosition(0,i)
oCell(i).String= i & ") LibreOffice"
next i
for i = 10 to 18
oCell(i) = oSheet.getCellByPosition(1, i - 10 )
oCell(i).String= i & ") Apache OpenOffice"
next i
oCell(0).CharUnderline = com.sun.star.awt.FontUnderline.NONE
oCell(1).CharUnderline = com.sun.star.awt.FontUnderline.SINGLE
oCell(2).CharUnderline = com.sun.star.awt.FontUnderline.DOUBLE
oCell(3).CharUnderline = com.sun.star.awt.FontUnderline.DOTTED
oCell(4).CharUnderline = com.sun.star.awt.FontUnderline.DONTKNOW
oCell(5).CharUnderline = com.sun.star.awt.FontUnderline.DASH
oCell(6).CharUnderline = com.sun.star.awt.FontUnderline.LONGDASH
oCell(7).CharUnderline = com.sun.star.awt.FontUnderline.DASHDOT
oCell(8).CharUnderline = com.sun.star.awt.FontUnderline.DASHDOTDOT
oCell(9).CharUnderline = com.sun.star.awt.FontUnderline.SMALLWAVE
oCell(10).CharUnderline = com.sun.star.awt.FontUnderline.WAVE
oCell(11).CharUnderline = com.sun.star.awt.FontUnderline.DOUBLEWAVE
oCell(12).CharUnderline = com.sun.star.awt.FontUnderline.BOLD
oCell(13).CharUnderline = com.sun.star.awt.FontUnderline.BOLDDOTTED
oCell(14).CharUnderline = com.sun.star.awt.FontUnderline.BOLDDASH
oCell(15).CharUnderline = com.sun.star.awt.FontUnderline.BOLDLONGDASH
oCell(16).CharUnderline = com.sun.star.awt.FontUnderline.BOLDDASHDOT
oCell(17).CharUnderline = com.sun.star.awt.FontUnderline.BOLDDASHDOTDOT
oCell(18).CharUnderline = com.sun.star.awt.FontUnderline.BOLDWAVE
msgbox "Success"
End Sub
Sub FontEffect()
Dim oDoc as Object, oSheet as Object, oCell as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
oCell.String = "LibreOffice"
' Font Effect
with oCell
.CharHeight = 20
.CharHeightAsian = 20
.CharUnderline = com.sun.star.awt.FontUnderline.DOUBLE
.CharUnderlineColor = RGB(255,0,0) ' Color of the Underline of Font
.CharUnderlineHasColor = true
end with
msgbox "Success"
End Sub
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oPreProp(0) as new com.sun.star.beans.PropertyValue
Dim oProp(2) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellRangeByName("A1")
oCell.String = "LibreOffficeです"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' A1 Cellへ移動
oPreProp(0).Name = "ToPoint"
oPreProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oPreProp())
' Under line
oProp(0).Name = "Underline.LineStyle"
oProp(0).Value = com.sun.star.awt.FontUnderline.WAVE ' = 10
oProp(1).Name = "Underline.HasColor"
oProp(1).Value = true
oProp(2).Name = "Underline.Color"
oProp(2).Value = &HFF0000 ' Red
oDispatcher.executeDispatch(oFrame, ".uno:Underline", "", 0, oProp())
msgbox "Success"
End Sub
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oPreProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellRangeByName("A1")
oCell.String = "LibreOffficeです(2)"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' A1 Cellへ移動
oPreProp(0).Name = "ToPoint"
oPreProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oPreProp())
' [ Under line ]
' Dot
oDispatcher.executeDispatch(oFrame, ".uno:UnderlineDotted", "", 0, Array())
msgbox "Dotted(ドット下線)",0,"下線"
' Under line削除 / 同じCommandを続けると削除される。
oDispatcher.executeDispatch(oFrame, ".uno:UnderlineDotted", "", 0, Array())
msgbox "Dotted(ドット下線)削除",0,"下線"
' Double
oDispatcher.executeDispatch(oFrame, ".uno:UnderlineDouble", "", 0, Array())
msgbox "Double(2重線)",0,"下線"
' Single
oDispatcher.executeDispatch(oFrame, ".uno:UnderlineSingle", "", 0, Array())
msgbox "Single(1重線)",0,"下線"
' None
oDispatcher.executeDispatch(oFrame, ".uno:UnderlineNone", "", 0, Array())
msgbox "None(下線無し)",0,"下線"
End Sub
Sub FontEffect()
Dim oDoc as Object, oSheet as Object, oCell as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
oCell = oSheet.getCellByPosition(0,0)
oCell.String = "LO ( 影付き )"
' Font Effect
with oCell
.CharFontName = "Arial"
.CharFontNameAsian = "Arial"
.CharHeight = 20
.CharHeightAsian = 20
.CharWeight = com.sun.star.awt.FontWeight.ULTRABOLD
.CharWeightAsian = com.sun.star.awt.FontWeight.ULTRABOLD
.CharShadowed = true
end with
msgbox "Success"
End Sub
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellRangeByName("A1")
oCell.String = "OSSでいこう"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' A1 Cellへ移動
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' Under line
oProp(0).Name = "Shadowed"
oProp(0).Value = true
oDispatcher.executeDispatch(oFrame, ".uno:Shadowed", "", 0, oProp())
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
Sub FontEffect()
Dim oDoc as Object, oSheet as Object, oCell as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' Font Effect
for i = 0 to 5
oCell = oSheet.getCellByPosition(0,i)
oCell.String = "LibreOfficeです"
with oCell
.CharHeight = 20
.CharHeightAsian = 20
end with
' Strikeouot
select case i
case 0
oCell.CharStrikeout = com.sun.star.awt.FontStrikeout.NONE ' 無し( = com.sun.star.awt.FontStrikeout.DONTKNOW )
case 1
oCell.CharStrikeout = com.sun.star.awt.FontStrikeout.SINGLE ' 一重線
case 2
oCell.CharStrikeout = com.sun.star.awt.FontStrikeout.DOUBLE ' 二重線
case 3
oCell.CharStrikeout = com.sun.star.awt.FontStrikeout.BOLD ' 太線
case 4
oCell.CharStrikeout = com.sun.star.awt.FontStrikeout.SLASH ' 斜線
case 5
oCell.CharStrikeout = com.sun.star.awt.FontStrikeout.X ' ×線
end select
next i
msgbox "Success"
End Sub
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellRangeByName("A1")
oCell.String = "OSSでいこう"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' A1 Cellへ移動
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' Strikeout
oProp(0).Name = "Strikeout.Kind"
oProp(0).Value = com.sun.star.awt.FontStrikeout.DOUBLE
oDispatcher.executeDispatch(oFrame, ".uno:Strikeout", "", 0, oProp())
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
'
'[ Note ]
' com.sun.star.awt.FontStrikeout.SINGLE : 1
' com.sun.star.awt.FontStrikeout.DOUBLE : 2
' com.sun.star.awt.FontStrikeout.DONTKNOW : 3 ← NONEと同じ
' com.sun.star.awt.FontStrikeout.BOLD : 4
' com.sun.star.awt.FontStrikeout.SLASH : 5
' com.sun.star.awt.FontStrikeout.X : 6
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oTextCursor as Object
Dim oText as String
'
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
for i = 0 to 4
oCell = oSheet.getCellByPosition( 0, i )
oText = "LibreOffficeです"
oCell.String = oText
'
oTextCursor = oCell.createTextCursor()
With oTextCursor
.gotoStart( False )
.goRight(Len(oText) , True )
.setPropertyValue("CharEmphasis", i )
.gotoEnd( False )
End With
next i
msgbox "Success"
End Sub
'
' [ Note ]
' Overlineは、WriterとCalcでは異なる。
' Calc : Type ⇒ 0 ~4, Color : NG
' Writer : Type ⇒ 0 ~18, Color : OK
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
Dim oText as String
'
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
for i = 0 to 4
oCell = oSheet.getCellByPosition( 0, i )
oText = "LO and AOOです"
oCell.String = oText
' Overline
oProp(0).Name = "Overline.LineStyle"
oProp(0).Value = i
' oProp(1).Name = "Overline.HasColor" ' Calcでは、Over lineの色は付かない
' oProp(1).Value = true
' oProp(2).Name = "Overline.Color"
' oProp(2).Value = &HFF0000
oDispatcher.executeDispatch(oFrame, ".uno:Overline", "", 0, oProp())
next i
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
'
' [ Note ]
' LibreOffice 4.2から強調文字と上線が区別されたので、上記Codeでは i = 1 で上線が入るだけ
Sub FontEffect()
Dim oDoc as Object, oSheet as Object, oCell as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' Font Effect
for i = 0 to 2
oCell = oSheet.getCellByPosition( 0, i )
oText = "LibreOffficeです"
oCell.String = oText
with oCell
.CharHeight = 20
.CharHeightAsian = 20
end with
' 浮き出し/浮き彫り
oTextCursor = oCell.createTextCursor()
With oTextCursor
.gotoStart( False )
.goRight(Len(oText) , True )
.setPropertyValue("CharRelief", i )
.gotoEnd( False )
End With
next i
msgbox "Success"
End Sub
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
for i = 0 to 2
oCell = oSheet.getCellByPosition(0, i)
oCell.String = "LO4.2.2です"
next i
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' A2 Cellへ移動
oProp(0).Name = "ToPoint"
oProp(0).Value = "A2"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' 浮き出し
oProp(0).Name = "CharacterRelief"
oProp(0).Value = 1
oDispatcher.executeDispatch(oFrame, ".uno:CharacterRelief", "", 0, oProp())
' A3 Cellへ移動
oProp(0).Name = "ToPoint"
oProp(0).Value = "A3"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' 浮き彫り
oProp(0).Name = "CharacterRelief"
oProp(0).Value = 2
oDispatcher.executeDispatch(oFrame, ".uno:CharacterRelief", "", 0, oProp())
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
Sub FontEffect()
Dim oDoc as Object, oSheet as Object, oCell as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
' Font Effect
oCell = oSheet.getCellByPosition( 0, 0 )
oText = "LibreOffficeです"
oCell.String = oText
with oCell
.CharHeight = 20
.CharHeightAsian = 20
.CharContoured = True
end with
msgbox "Success"
End Sub
Sub CalcUnoFont()
Dim oDoc As Object, oSheet As Object, oCell as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oCell = oSheet.getCellByPosition(0, 0)
oCell.String = "LO4.2.2です"
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' A1 Cellへ移動
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' 中抜き
oProp(0).Name = "OutlineFont"
oProp(0).Value = true
oDispatcher.executeDispatch(oFrame, ".uno:OutlineFont", "", 0, oProp())
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
{{ Position / Size }}
Sub CellPropertiesSrv()
Dim oDoc as Object, oSheet as Object
Dim oCell(3) as Object
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
for i = 0 to 3
oCell(i) = oSheet.getCellByPosition(0,i)
oCell(i).Value = i*10
next i
oCell(0).VertJustify = com.sun.star.table.CellVertJustify.STANDARD
oCell(1).VertJustify = com.sun.star.table.CellVertJustify.TOP
oCell(2).VertJustify = com.sun.star.table.CellVertJustify.CENTER
oCell(3).VertJustify = com.sun.star.table.CellVertJustify.BOTTOM
msgbox("Success")
End Sub
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
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
Sub UnoHideVisible()
Dim oDoc as Object, oSheet as Object
Dim oCell(8) as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
for i = 0 to 6
oCell(i) = oSheet.getCellByPosition(0,i)
select case i
case 0
oCell(i).String = "水平 / 両端揃え"
case 1
oCell(i).String = "水平 / 左揃え"
case 2
oCell(i).String = "水平 / 右揃え"
case 3
oCell(i).String = "水平 / 中央揃え"
case 4
oCell(i).String = "垂直 / 上揃え"
case 5
oCell(i).String = "垂直 / 中央揃え"
case 6
oCell(i).String = "垂直 / 下揃え"
end select
next i
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'
' Position
oProp(0).Name = "ToPoint"
oProp(0).Value = "A1"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:AlignBlock", "", 0, Array())
oProp(0).Name = "ToPoint"
oProp(0).Value = "A2"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:AlignLeft", "", 0, Array())
oProp(0).Name = "ToPoint"
oProp(0).Value = "A3"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:AlignRight", "", 0, Array())
oProp(0).Name = "ToPoint"
oProp(0).Value = "A4"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:AlignHorizontalcenter", "", 0, Array())
oProp(0).Name = "ToPoint"
oProp(0).Value = "A5"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:AlignTop", "", 0, Array())
oProp(0).Name = "ToPoint"
oProp(0).Value = "A6"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:AlignVCenter", "", 0, Array())
oProp(0).Name = "ToPoint"
oProp(0).Value = "A7"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:AlignBottom", "", 0, Array())
msgbox "Success", 0, "Position"
End Sub
Sub CellPropertiesSrv()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oCellName as String
Dim oPos as Long
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oCellName = "B3"
oCell =oSheet.getCellRangeByName(oCellName)
oPos = oCell.Position.X/100
oDisp = oCellName & " Cellの左端位置 は" & Chr(10) & Chr$(9) & _
oPos & " [mm] from left" & Chr$(10) & Chr$(9) & " ( A列の幅とほぼ同じ )"
msgbox(oDisp,0,"Cell の位置")
End Sub
Sub CellPropertiesSrv()
Dim oDoc as Object, oSheet as Object, oCell as Object
Dim oCellName as String
Dim oPos as Long
oDoc = ThisComponent
oSheet = oDoc.getSheets().getByName("sheet1")
oCellName = "B3"
oCell =oSheet.getCellRangeByName(oCellName)
oPos = oCell.Position.Y/100
oDisp = oCellName & " Cellの上端位置 は" & Chr(10) & Chr$(9) & _
oPos & " [mm] from top" & Chr$(10) & Chr$(9) & " ( 1行目 + 2行目高さとほぼ同じ )"
msgbox(oDisp,0,"Cell の位置")
End Sub
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
{{ 罫線 }}
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
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
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も限定される模様。
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の設定は不可?
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
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
{{ Protection }}
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
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
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
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
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
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
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 }}
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
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 }}
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
{{ Annotation( 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
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
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
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
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
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
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
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
Sub CalcAnnotation()
Dim oDoc as Object, oSheet as Object
Dim oCell(14) as Object
Dim oShtName as String
Dim oCmtStr as String
Dim oCmt as Object
Dim oAntShape as Object
Dim oDisp as String
oDoc = ThisComponent
oShtName = "sheet1"
oSheet = oDoc.getSheets().getByName(oShtName)
'
for i = 0 to 13
if i < 7 then
oCell(i) = oSheet.getCellByPosition(0, 3 + 3*i )
else
oCell(i) = oSheet.getCellByPosition(3, 3 + 3*(i-7))
end if
oCmt = oCell(i).getAnnotation()
' Properties of Line
select case i
case 0
oCmtStr = "破線(No LineDashName)"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr) ' LineのProperties変更前にCommentを設定する必要がある。
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape ' Comment設定後に取得する必要がある。
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(255,0,0)
case 1
oCmtStr = "極細の破線"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
oAntShape.LineDashName = "Ultrafine Dashed"
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(200,50,0)
case 2
oCmtStr = "細かい破線"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
oAntShape.LineDashName = "Fine Dashed"
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(150,100,0)
case 3
oCmtStr = "二点三破線"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
oAntShape.LineDashName = "Ultrafine 2 Dots 3 Dashes" ' ← いつからか追加されている
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(100,150,0)
case 4
oCmtStr = "細かい点線"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
oAntShape.LineDashName = "Fine Dotted"
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(50,200,0)
case 5
oCmtStr = "細かい点線が集まった線"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
oAntShape.LineDashName = "Line with Fine Dots"
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(0,255,0)
case 6
oCmtStr = "細かい破線(可変)"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
oAntShape.LineDashName = "Fine Dashed (var)" ' LO5.0.2では線のスタイルに項目が無い(細かい破線と同じ) / AOO4.0.2では線種がある
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(0,200,50)
case 7
oCmtStr = "三破線三点鎖線"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
oAntShape.LineDashName = "3 Dashes 3 Dots (var)"
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(0,150,100)
case 8
oCmtStr = "極細の点線(可変)"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
oAntShape.LineDashName = "Ultrafine Dotted (var)" ' LO5.0.2では線のスタイルに項目が無い(極細の破線と同じ) / AOO4.0.2では線種がある
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(0,100,150)
case 9
oCmtStr = "線スタイル9"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
oAntShape.LineDashName = "Line Style 9"
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(0,50,200)
case 10
oCmtStr = "二点鎖線"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
oAntShape.LineDashName = "2 Dots 1 Dash"
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(0,0,255)
case 11
oCmtStr = "破線(可変)"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.DASH
oAntShape.LineDashName = "Dashed (var)"
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(200,200,200)
case 12
oCmtStr = "実線"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
oAntShape = oCmt.annotationShape
oAntShape.LineStyle = com.sun.star.drawing.LineStyle.SOLID
oAntShape.LineWidth = 100
oAntShape.LineColor = RGB(100,100,100)
case 13
oCmtStr = "設定なし"
oSheet.getAnnotations().insertNew(oCell(i).getCellAddress(), oCmtStr)
oCmt.setIsVisible( True )
' oAntShape = oCmt.annotationShape
' oAntShape.LineStyle = com.sun.star.drawing.LineStyle.NONE ' Errorになる
end select
next i
'
oDisp = "Success( LO5.0.2 )"
msgbox oDisp,0,"Annotation"
End Sub
'
' [ Note ]
' Reference Site : Basic OpenOffice( Apache OpenOffice Basic en espanol )
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
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
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
[ 内容の削除 ]
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.
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 : 全て
Sub subClearWrksheet(i as integer,sRange as string)
Dim oRange as object
oRange = ThisComponent.getSheets().getByIndex(i).getCellRangeByName(sRange)
oRange.clearContents(511)
End Sub
Sub subClearWrksheet()
Dim oRange as object
'oRange = ThisComponent.getSheets().getByIndex(0).getCellRangeByName(sRange)
oRange = ThisComponent.getSheets().getByIndex(0)
oRange.clearContents(511)
msgbox "Success",0,"LO6.4.3.2(x64)"
End Sub
'
' clearContentsの値は以下。複数の場合は加算。clearContents() = clearContents(1+2+4+8+16+32+64+128+256)
' 1 : 数値をクリアする場合
' 2 : 日付や時刻をクリアする場合
' 4 : 文字列をクリアする場合
' 8 : セルのコメントをクリアする場合
' 16 : 関数 (数式) をクリアする場合
' 32 : セルに直接指定された書式をクリアする場合
' 64 : セルに間接的に指定された書式をクリアする場合
' 128 : セルに配置された描画オブジェクトをクリアする場合
' 256 : セル内の一部のテキストに対してのみ指定された書式をクリア
[ Selection ]
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が不要になれば選択解除を行うこと。
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
Sub UnoSelection()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oProp(0).Name = "ToPoint"
oProp(0).Value = "B3"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
oDispatcher.executeDispatch(oFrame, ".uno:SelectData", "", 0, Array())
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
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が不要になれば選択解除を行うこと。
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
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
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が不要になれば選択解除を行うこと。
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
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
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
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) になる
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
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
Sub CalcSelection()
Dim oDoc as Object, oSheet as Object, oCellA as Object, oCellB as Object, oCellC as Object, oCellD as Object, oCellE as Object
Dim oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc=ThisComponent
oSheet = oDoc.getSheets().getByIndex(0)
for i = 0 to 4
oCellA = oSheet.getCellByPosition(0, i )
oCellB = oSheet.getCellByPosition(1, i )
oCellC = oSheet.getCellByPosition(2, i )
oCellD = oSheet.getCellByPosition(3, i )
oCellE = oSheet.getCellByPosition(4, i )
oCellA.Value = i + 1
oCellB.Formula = "=A" & (i + 1) & "*10"
oCellC.Formula = "=A" & (i + 1) & "+ B" & (i + 1)
oCellD.Formula = "=B" & (i + 1) & "^2"
oCellE.Formula = "=C" & (i + 1) & "^2"
next i
'
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' C3 Cellへ移動
oProp(0).Name = "ToPoint"
oProp(0).Value = "C3"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' Ctrl + Shift + ↑
oDispatcher.executeDispatch(oFrame, ".uno:GoUpToStartOfDataSel", "", 0, Array())
msgbox "Ctrl + Shift + 上矢印",0,"範囲選択"
' Ctrl + Shift + ↓
oDispatcher.executeDispatch(oFrame, ".uno:GoDownToEndOfDataSel", "", 0, Array())
msgbox "Ctrl + Shift + 下矢印",0,"範囲選択"
' Ctrl + Shift + ←
oDispatcher.executeDispatch(oFrame, ".uno:GoLeftToStartOfDataSel", "", 0, Array())
msgbox "Ctrl + Shift + 左矢印",0,"範囲選択"
' Ctrl + Shift + →
oDispatcher.executeDispatch(oFrame, ".uno:GoRightToEndOfDataSel", "", 0, Array())
msgbox "Ctrl + Shift + 右矢印",0,"範囲選択"
End Sub
Sub CalcSelection()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
Dim oProp(0) as new com.sun.star.beans.PropertyValue
oDoc=ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' S10 Cellへ移動
oProp(0).Name = "ToPoint"
oProp(0).Value = "R10"
oDispatcher.executeDispatch(oFrame, ".uno:GoToCell", "", 0, oProp())
' Page Down
msgbox "R10 Cell !!",0,"表示画面Areaの選択"
oDispatcher.executeDispatch(oFrame, ".uno:GoDownBlockSel", "", 0, Array())
msgbox "Page Down Area Selected",0,"表示画面Areaの選択"
' Page Left
oDispatcher.executeDispatch(oFrame, ".uno:GoLeftBlockSel", "", 0, Array())
msgbox "Page Left Area Selected",0,"表示画面Areaの選択"
' Page Up
oDispatcher.executeDispatch(oFrame, ".uno:GoUpBlockSel", "", 0, Array())
msgbox "Page Up Area Selected",0,"表示画面Areaの選択"
' Page Right
oDispatcher.executeDispatch(oFrame, ".uno:GoRightBlockSel", "", 0, Array())
msgbox "Page Right Area Selected",0,"表示画面Areaの選択"
End Sub
Sub UnoSelection()
Dim oDoc as Object, oCtrl as Object, oFrame as Object
Dim oDispatcher as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oFrame = oCtrl.getFrame()
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oDispatcher.executeDispatch(oFrame, ".uno:SelectDB", "", 0, Array())
msgbox "Success" & Chr$(10) & "( DispatchHelper )"
End Sub
Sub SheetSelection()
Dim oDoc as Object, oCtrl as Object
Dim oSelRange as Object
oDoc = ThisComponent
oCtrl = oDoc.getCurrentController()
oSelRange = oCtrl.getActiveSheet()
oCtrl.select( oSelRange )
'
msgbox "Success",0,"LO6.4.3.2(x64)"
End Sub
[ Address ]
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
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 になる。
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
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
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
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
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
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
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
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
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 ' 1つしかCellを選択していないので、 .EndColumn でも同じ
oStartRow = oCursor.getRangeAddress.EndRow ' 1つしかCellを選択していないので、 .StartRow でも同じ
oCursor.gotoEnd() ' Dataの最後へ
oEndCol = oCursor.getRangeAddress.StartColumn ' 1つしかCellを選択していないので、 .StartColumn でも同じ
oEndRow = oCursor.getRangeAddress.EndRow ' 1つしか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 ' 1つしかCellを選択していないので、 .EndColumn でも同じ
oStartRow = oCursor.getRangeAddress.EndRow ' 1つしかCellを選択していないので、 .StartRow でも同じ
oCursor.gotoEnd() ' Dataの最後へ
oEndCol = oCursor.getRangeAddress.StartColumn ' 1つしかCellを選択していないので、 .StartColumn でも同じ
oEndRow = oCursor.getRangeAddress.EndRow ' 1つしか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 ' 1つしかCellを選択していないので、 .EndColumn でも同じ
oStartRow = oCursor.getRangeAddress.EndRow ' 1つしかCellを選択していないので、 .StartRow でも同じ
oCursor.gotoEnd() ' Dataの最後へ
oEndCol = oCursor.getRangeAddress.StartColumn ' 1つしかCellを選択していないので、 .StartColumn でも同じ
oEndRow = oCursor.getRangeAddress.EndRow ' 1つしか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) "
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) "