Formatierung eines CellRange auf ein anderes CellRange übertragen

[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

[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

[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

[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