Seite 1 von 1
Formatierung eines CellRange auf ein anderes CellRange übertragen
Verfasst: Sa 17. Jan 2026, 22:54
von Cepheus
Nach Kopieren und Einfügen eines Zellbereichs im Calc möchte ich Formate eines anderen Zellbereichs auf den einkopierten Zellbereich übertragen. Zur Generierung eines Makros im Makrorekorder habe ich
Format -> Formatierung übertragen ... nachvollzogen, aber es funktioniert nicht. Für eine Hilfe / Empfehlung bedanke ich mich in voraus.
Cepheus
Der generierte Code:
Code: Alles auswählen
Sub FormatierungUebertragen
REM Diesen Code generierte der Makrorekorder
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem --------------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$J$16:$O$16"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem --------------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:FormatPaintbrush", "", 0, Array())
rem --------------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"
args3(0).Value = "$J$19:$O$22"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())
REM Ergebnis:
REM Nach der Ausführung war der Zielbereich (korrekt) ausgewählt
REM und der Mauszeiger bekam auch die typische Form zur Formatübertragung.
REM Formate wurden jedoch nicht übertragen !
REM Es fehlt offenbar ein passender dispatcher-Befehl,
REM der VOR dem zweiten uno:GoToCell wirken soll. Aber welcher?
End Sub
Re: Formatierung eines CellRange auf ein anderes CellRange übertragen
Verfasst: So 18. Jan 2026, 16:21
von mikele
Hallo,
so quick&dirty würde ich es via Kopieren und (Formate-)Einfügen versuchen:
Code: Alles auswählen
Sub FormatierungUebertragen
REM Diesen Code generierte der Makrorekorder
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem --------------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$J$16:$O$16"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
rem --------------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"
args3(0).Value = "$J$19"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())
rem ----------------------------------------------------------------------
dim args4(5) as new com.sun.star.beans.PropertyValue
args4(0).Name = "Flags"
args4(0).Value = "T"
args4(1).Name = "FormulaCommand"
args4(1).Value = 0
args4(2).Name = "SkipEmptyCells"
args4(2).Value = false
args4(3).Name = "Transpose"
args4(3).Value = false
args4(4).Name = "AsLink"
args4(4).Value = false
args4(5).Name = "MoveMode"
args4(5).Value = 4
dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args4())
End Sub
Re: Formatierung eines CellRange auf ein anderes CellRange übertragen
Verfasst: So 18. Jan 2026, 21:08
von Cepheus
Hallo, mikele,
dein Lösungsansatz hat mich begeistert! Danke dafür. Damit bin ich der Lösung schon näher gekommen, aber leider noch nicht erreicht. Denn beim Kopiern wird der Zielbereich (definiert durch 1 Zelle) genau so groß wie der Quellbereich. Somit formatiert dein Makro eben nur die erste Zeile meines 4-zeiligen Zellbereichs (der sich über 6 verschieden formatierte Spalten erstreckt).
Für eine Erweiterung deines Makros wäre ich dir wirklich sehr dankbar.
Ein weiteres - kleines - Problem steckt in deinem Lösungsansatz auch noch darin: Wie kriege ich per Makro den beim Kopieren entstandenen Laufrahmen wieder weg?
Gruß
Cepheus
Re: Formatierung eines CellRange auf ein anderes CellRange übertragen
Verfasst: Mo 19. Jan 2026, 22:22
von Cepheus
Hallo, mikele,
ergänzend möchte ich berichten, dass dein quick&dirty-Lösungsansatz via (Format-)Kopieren doch makellos funktioniert: man muss nur als Kopierziel einen mehrzeiligen Bereich statt die Eckzelle definieren. Etwa so:
Code: Alles auswählen
Sub FormatierungUebertragen
' Von mikele, 2026-01-18
' so quick&dirty würde ich es via Kopieren und (Formate-)Einfügen versuchen:
' (Am 2026-01-19 adaptiert vo mir.)
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
Dim oDoc
Dim oSheets
Dim oSheet
Dim oRangeSrc 'Qullbereich, hier mehrere Spalten einer /1-er/ Zeile
Dim sSrc As String 'Name des 1-zeiligen Bereichs
Dim oRangeDest 'Zielbereich, hier mehrere Spalten mehrerer Zeilen
Dim sDest As String 'Name des mehrzeiligen Bereichs
oDoc = ThisComponent
oSheets = oDoc.Sheets
oSheet = oSheets.getByIndex(5) 'Tabelle6
REM Quellbereich
oRangeSrc = oSheet.getCellRangeByPosition(9, 15, 14, 15) 'Zeile 16, Spalten J bis O
' "$J$16:$O$16"
sSrc = oRangeSrc.AbsoluteName
REM Zielbereich
oRangeDest = oSheet.getCellRangeByPosition(9, 18, 14, 21) 'Zeilen 19 bis 22, Spalten J bis O
' "$J$19:$O$22"
sDest = oRangeDest.AbsoluteName
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem QUELLE -------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
' args1(0).Value = "$J$16:$O$16"
args1(0).Value = sSrc
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem --------------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
rem ZIEL ---------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"
' args3(0).Value = "$J$19:$O$22" 'Name eines mehzeiligen Bereichs
' 'gleicher Spaltenanzahl wie bei Quelle
args3(0).Value = sDest
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())
rem ----------------------------------------------------------------------
dim args4(5) as new com.sun.star.beans.PropertyValue
args4(0).Name = "Flags"
args4(0).Value = "T"
args4(1).Name = "FormulaCommand"
args4(1).Value = 0
args4(2).Name = "SkipEmptyCells"
args4(2).Value = false
args4(3).Name = "Transpose"
args4(3).Value = false
args4(4).Name = "AsLink"
args4(4).Value = false
args4(5).Name = "MoveMode"
args4(5).Value = 4
dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args4())
End Sub
Noch einmal danke! Offen ist nur noch, wie man per Makro den Kopier-Laufrahmen um die Quelle wieder abschaltet.
Gruß,
Cepheus