Tabellenrand Zellrand

Programmierung unter AOO/LO (StarBasic, Python, Java, ...)

Moderator: Moderatoren

moritz
*****
Beiträge: 216
Registriert: Mi, 20.10.2004 20:54

Tabellenrand Zellrand

Beitrag von moritz »

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
moritz
*****
Beiträge: 216
Registriert: Mi, 20.10.2004 20:54

Ergänzung

Beitrag von moritz »

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
Stephan
********
Beiträge: 12369
Registriert: Mi, 30.06.2004 19:36
Wohnort: nahe Berlin

Beitrag von Stephan »

Hat jemand einen Tip dazu?
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 ?

Gruß
Stephan
moritz
*****
Beiträge: 216
Registriert: Mi, 20.10.2004 20:54

CreateUnoStruct("com.sun.star.table.BorderLine")

Beitrag von moritz »

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
moritz
*****
Beiträge: 216
Registriert: Mi, 20.10.2004 20:54

Lösung

Beitrag von moritz »

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
Antworten