Ich habe ein Makro geschrieben, welches ein Gitternerz mit Lienien erstellt. Abschliessend möchte ich alle diese Linien per Makro noch gruppieren, so dass das erstellte Raster als Ganzes verschoben werden kann. Hier ist mal der Code:
Sub Test()
Gitternetz(5, 50, 100) 'angaben in mm
End sub
Sub Gitternetz(abstand as integer, laenge as integer, hoehe as integer)
Dim oDoc as object, oFrame as Object
Dim oTxtCur as object, oFrameCur as Object
Dim oText as object
Dim oLinie as object
Dim oCur as object
Dim size as new com.sun.star.awt.Size
Dim bLine as new com.sun.star.table.BorderLine
oShapes = createUnoService("com.sun.star.drawing.ShapeCollection")
oDoc = ThisComponent
oTxtCur = oDoc.text.createTextCursor()
' Längenangaben von mm in 1/1000cm umrechnen
abstand = abstand*100
laenge = laenge*100
hoehe = hoehe*100
anzahl_hLinien = hoehe / abstand
anzahl_vLinien = laenge / abstand
' Horizontale Linien zeichnen und Rasterhinzufügen
for horizontal = 0 to anzahl_hLinien
oLinie = oDoc.createInstance("com.sun.star.drawing.LineShape")
size.Width = laenge
size.Height = 0
With oLinie
.LineColor = rgb(0, 0, 0)
.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
.Size = size
.TextWrap = com.sun.star.text.WrapTextMode.THROUGHT
.VertOrientPosition = abstand * horizontal + abstand
.HoriOrientPosition = abstand
.lineWidth = 0
.sizeProtect = true
.MoveProtect = true
End With
oDoc.text.insertTextContent(oTxtCur, oLinie, false)
oShapes.add(oLinie)
next
' Horizontale Linien zeichnen und Rasterhinzufügen
for vertikal = 0 to anzahl_vLinien
oLinie = oDoc.createInstance("com.sun.star.drawing.LineShape")
size.Width = 0
size.Height = hoehe
With oLinie
.LineColor = rgb(0, 0, 0)
.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
.Size = size
.TextWrap = com.sun.star.text.WrapTextMode.THROUGHT
.HoriOrientPosition = abstand * vertikal + abstand
.VertOrientPosition = abstand
.lineWidth = 0
.sizeProtect = true
.MoveProtect = true
End With
oDoc.text.insertTextContent(oTxtCur, oLinie, false)
oShapes.add(oLinie)
next
Group = oDoc.text.group(Shapes)
Leider bricht der Code ganz am Schluss bei Group = oDoc.text.group(Shapes) ab. Ich krieg es einfach nicht auf die Reihe die Linien zu gruppieren. Kann da jemand (vielleicht dogar du) weiterhelfen???
Freundliche Grüsse
Zuletzt geändert von msg132e am Mi, 09.04.2014 11:46, insgesamt 1-mal geändert.
Entschuldigt, dass diese Frage in zwei unterschiedliechen Foren gestellt wurde. Ich habe diese zuerst im Libre-Office-Forum erstellt und gesehen, dass dieses viel öfter angesehen wird. Ich hoffe die Frage kann hier in diesem Forum beantwortet werden...
Sub GroupShapeObj()
Dim oDoc as Object
Dim oDrawPage as Object
Dim oShapeGroup as Object
oDoc = ThisComponent
oDrawPage = oDoc.DrawPage
oShapeGroup = CreateUnoService("com.sun.star.drawing.ShapeCollection")
for i = 0 to oDrawPage.getCount()-1
oShapeGroup.add(oDrawPage.getByIndex(i))
next i
oDrawPage.group(oShapeGroup)
End Sub
Public oDoc as object
Public oLinie as object
Public oTxtCur as Object
Sub Test()
Gitternetz(5, 50, 100,2) 'angaben in mm
End sub
Sub Gitternetz(abstand as integer, breite as integer, hoehe as integer, aussenabstand as integer)
'Gruppierungs-Objekt für das Gitternetz erstellen
oShapeGroup = createUnoService("com.sun.star.drawing.ShapeCollection")
' Längenangaben von mm in 1/1000cm umrechnen
abstand = abstand*100
breite = breite*100
hoehe = hoehe*100
aussenabstand = aussenabstand*100
'Anzahl Linien Berechnen
anzahl_hLinien = hoehe / abstand
anzahl_vLinien = breite / abstand
' Horizontale Linien
for horizontal = 0 to anzahl_hLinien
'Position der Linien bestimmen
HoriOrientPosition = 0
VertOrientPosition = abstand * horizontal
' Horizontale Linien zeichnen
LinienZeichnen(HoriOrientPosition, VertOrientPosition, 0, breite)
' Linie dem Gitternetz hinzufügen, welches später gruppiert wird
oShapeGroup.add(oLinie)
next
' Vertikale Linien
for vertikal = 0 to anzahl_vLinien
'Position der Linien bestimmen
HoriOrientPosition = abstand * vertikal
VertOrientPosition = 0
' Vertikale Linien zeichnen
LinienZeichnen(HoriOrientPosition, VertOrientPosition, hoehe, 0)
' Linie dem Gitternetz hinzufügen, welches später gruppiert wird
oShapeGroup.add(oLinie)
next
'Gitternetz gruppieren
oGruppe = ThisComponent.DrawPage.group(oShapeGroup)
With oGruppe
.TopMargin = aussenabstand
.BottomMargin = aussenabstand
.LeftMargin = aussenabstand
.RightMargin = aussenabstand
end With
End Sub
Function LinienZeichnen(x as integer, y as integer, hoehe as integer, breite as integer)
'Neue Linie vorbereiten
oLinie = ThisComponent.createInstance("com.sun.star.drawing.LineShape")
'Grösse der Linien bestimmen
Dim size as new com.sun.star.awt.Size
size.Height = hoehe
size.Width = breite
With oLinie
.LineColor = rgb(0, 0, 0)
.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH
.TextWrap = com.sun.star.text.WrapTextMode.THROUGHT
.lineWidth = 0
.sizeProtect = true
.MoveProtect = true
.HoriOrientPosition = x
.VertOrientPosition = y
.Size = size
End With
'Einfügeort bestimmen
oViewC = ThisComponent.getCurrentController().getViewCursor()
If isEmpty(oViewC.textTable) then
'Linien im Text einfügen
oTextC = ThisComponent.text.createTextCursorByRange(oViewC)
ThisComponent.text.insertTextContent(oViewC, oLinie, false)
Else
'Linien in Tabelle einfügen
oZelle = oViewC.Cell
oTextC = oZelle.createTextCursorByRange(oViewC)
oTextC.getText().insertTextContent(oViewC, oLinie, false)
Endif
End Function