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