Hallo,
wie kann man in einer Calc- Tabelle Zellen einen Rand geben? Der folgende Code ist in VBA geschrieben, weil ich von Acad aus eine OpenOffice- Tabelle anlegen und ausfüllen will. Nur mit der Formatierung habe ich Probleme.
Dim objServiceManager As Object
Dim objDesktop As Object
Dim CellRangeAddress As Object
Set objServiceManager = CreateObject("com.sun.star.ServiceManager")
Set objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
Dim args()
Set objWorkBook = objDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, args)
Set objWorksheet = objWorkBook.Sheets(0)
Set objWorksheet = objWorkBook.Sheets.GetByname("Tabelle1")
Dim objZelle As Object
objWorksheet.name = "Flächen"
Dim CellRange As Object
Set CellRange = objWorksheet.getCellRangeByName("A3:D3")
CellRange.CellBackColor = RGB(0, 250, 0)
Set objZelle = objWorksheet.getCellByPosition(1, 1)
objZelle.String = "Flächenermittlung " & ThisDrawing.name
objWorksheet.getCellByPosition(0, 2).String = "Pos"
usw., anschließend werden in Acad Blockattribute ausgelesen und in Zellen eingetragen.
Wie können die Zellen aber einen Rand in der entsprechenden Breite bekommen?
Danke
Moritz
Tabellenrand Zellrand
Moderator: Moderatoren
Ergänzung
Ich habe den Code um folgende Zeilen ergänzt:
Set CellRange = objWorksheet.getCellRangeByName("A5:D5")
CellRange.BottomBorder.Color = RGB(250, 0, 0)
CellRange.BottomBorder.OuterLineWidth = 100
CellRange.BottomBorder.InnerLineWidth = 100
CellRange.BottomBorder.LineDistance = 10
Es kommt keine Fehlermeldung, aber es wird auch kein Rand gezeichnet. Hat jemand einen Tip dazu?
Moritz
Set CellRange = objWorksheet.getCellRangeByName("A5:D5")
CellRange.BottomBorder.Color = RGB(250, 0, 0)
CellRange.BottomBorder.OuterLineWidth = 100
CellRange.BottomBorder.InnerLineWidth = 100
CellRange.BottomBorder.LineDistance = 10
Es kommt keine Fehlermeldung, aber es wird auch kein Rand gezeichnet. Hat jemand einen Tip dazu?
Moritz
Dann müßte ich auch erstmal rumexperimentieren. Hilft Dir dieser Link: http://www.bcwin.ch/ooo/basic/calc/calc.html#6.6 Rahmen von Zellen und Zellbereichen ?Hat jemand einen Tip dazu?
Gruß
Stephan
CreateUnoStruct("com.sun.star.table.BorderLine")
Danke, so genau hatte ich das Thema bis jetzt tatsächlich nicht gefunden. Trotzdem scheitere ich noch an der Übersetzung in VBA:
Hier ein Beispiel in StarBasic
Sub zellRahmenDirekt
' Variable deklarieren
Dim oZellbereich as Object
Dim oRahmenLinie as Object
oZellbereich = ThisComponent.Sheets(0).getCellRangeByName( "B2:B8" )
' Rahmenlinie erstellen
oRahmenLinie = CreateUnoStruct("com.sun.star.table.BorderLine")
' Eigenschaften der Linie definieren
With oRahmenLinie
.Color = RGB( 255, 0, 0 )
.InnerLineWidth = 0
.OuterLineWidth = 8
.LineDistance = 0
End With
' einzelne Rahmen setzen
oZellbereich.TopBorder = oRahmenLinie
oZellbereich.BottomBorder = oRahmenLinie
oZellbereich.LeftBorder = oRahmenLinie
oZellbereich.RightBorder = oRahmenLinie
End Sub
Als Problem erscheint mir die Zeile
oRahmenLinie = CreateUnoStruct("com.sun.star.table.BorderLine")
Wie muß dies in VBA heißen?
CreateUnoStruct kennt VBA nicht.
Konstruktionen wie
Set oRahmenLinie = objDesktop.createUNOStruct("com.sun.star.table.BorderLine")
helfen leider auch nicht..
Danke Moritz
Hier ein Beispiel in StarBasic
Sub zellRahmenDirekt
' Variable deklarieren
Dim oZellbereich as Object
Dim oRahmenLinie as Object
oZellbereich = ThisComponent.Sheets(0).getCellRangeByName( "B2:B8" )
' Rahmenlinie erstellen
oRahmenLinie = CreateUnoStruct("com.sun.star.table.BorderLine")
' Eigenschaften der Linie definieren
With oRahmenLinie
.Color = RGB( 255, 0, 0 )
.InnerLineWidth = 0
.OuterLineWidth = 8
.LineDistance = 0
End With
' einzelne Rahmen setzen
oZellbereich.TopBorder = oRahmenLinie
oZellbereich.BottomBorder = oRahmenLinie
oZellbereich.LeftBorder = oRahmenLinie
oZellbereich.RightBorder = oRahmenLinie
End Sub
Als Problem erscheint mir die Zeile
oRahmenLinie = CreateUnoStruct("com.sun.star.table.BorderLine")
Wie muß dies in VBA heißen?
CreateUnoStruct kennt VBA nicht.
Konstruktionen wie
Set oRahmenLinie = objDesktop.createUNOStruct("com.sun.star.table.BorderLine")
helfen leider auch nicht..
Danke Moritz
Lösung
So funktionierts, danke, Stephan und die anderen, von denen ich die Codeschnipsel zusammengebastelt habe.
........................................
Dim CellRange As Object
Set CellRange = objWorksheet.getCellRangeByName("A3:D3")
CellRange.CellBackColor = RGB(0, 250, 0)
' Variable für den Rahmen deklarieren
Dim oRahmenLinie As Object
Set oRahmenLinie = createUNOStruct("com.sun.star.table.BorderLine")
' Eigenschaften der Linie definieren
With oRahmenLinie
.Color = RGB(255, 0, 250)
.InnerLineWidth = 20
.OuterLineWidth = 100
.LineDistance = 50
End With
' einzelne Rahmen setzen
Set CellRange.TopBorder = oRahmenLinie
CellRange.BottomBorder = oRahmenLinie
CellRange.LeftBorder = oRahmenLinie
CellRange.RightBorder = oRahmenLinie
..................................................................
Private Function createUNOStruct(strTypeName)
Dim objServiceManager As Object
Dim objCoreReflection As Object
Dim classSize As Object
Set objServiceManager = CreateObject("com.sun.star.ServiceManager")
Set objCoreReflection = objServiceManager.createInstance("com.sun.star.reflection.CoreReflection")
Set classSize = objCoreReflection.forName(strTypeName)
Dim aStruct
classSize.CreateObject aStruct
Set createUNOStruct = aStruct
End Function
Moritz
........................................
Dim CellRange As Object
Set CellRange = objWorksheet.getCellRangeByName("A3:D3")
CellRange.CellBackColor = RGB(0, 250, 0)
' Variable für den Rahmen deklarieren
Dim oRahmenLinie As Object
Set oRahmenLinie = createUNOStruct("com.sun.star.table.BorderLine")
' Eigenschaften der Linie definieren
With oRahmenLinie
.Color = RGB(255, 0, 250)
.InnerLineWidth = 20
.OuterLineWidth = 100
.LineDistance = 50
End With
' einzelne Rahmen setzen
Set CellRange.TopBorder = oRahmenLinie
CellRange.BottomBorder = oRahmenLinie
CellRange.LeftBorder = oRahmenLinie
CellRange.RightBorder = oRahmenLinie
..................................................................
Private Function createUNOStruct(strTypeName)
Dim objServiceManager As Object
Dim objCoreReflection As Object
Dim classSize As Object
Set objServiceManager = CreateObject("com.sun.star.ServiceManager")
Set objCoreReflection = objServiceManager.createInstance("com.sun.star.reflection.CoreReflection")
Set classSize = objCoreReflection.forName(strTypeName)
Dim aStruct
classSize.CreateObject aStruct
Set createUNOStruct = aStruct
End Function
Moritz