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

[mikele]

Hallo,
um es vielleicht weniger quick&dirty zu lösen: Wie sieht denn die Formatierung der Zellen aus, die du übertragen willst? Hast du eine Beispieldatei?

[Cepheus]

Hallo, mikele,
gerne schicke ich dir meine Testdatei. Wie du siehst, habe ich den zu formatierenden (mehrzeiligen) Bereich absichtlich mit z.T. sinnlosen Formaten versehen. - Falls du wieder copy anwenden möchtest, bitte nicht vergessen, nach der Foramtierung die "laufenden Ameisen" (Escape-Taste) abzudrehen.

Noch einmal danke,
Cepheus

P.: In deinem ersten Lösungsansatz hast du den dispacher eingesetzt. Da ich von diesem wenig Ahnung habe, habe ich im Internet nach ".uno:InsertContents" gesucht, um das Argument-Array zu verstehen. Leider nichts gefunden. Könntest du mir bitte sagen, wo ich, ganz allgemein, Argumente zu einem bestimmten dispacher-Befehl finden kann?

[mikele]

Hallo,
für den allgemeinen Fall ist es meines Wissen nicht so einfach, die Formatierungen per API zu übertragen (es sind einfach zu viele mögliche Formatierungen). Daher war meine Hoffnung, dass es ganz bestimmte Formatierungen sind, die du übertragen möchtest.
Eine Übersicht über die Dispatcher-Befehle findest du hier
https://wiki.documentfoundation.org/Dev ... chCommands
Den Dispatcher habe ich erstens benutzt, weil dein Ansatz ebenfalls startete (die Makroaufzeichnung macht nichts anderes) und zweitens weil, glaube ich, das Kopieren des Formats einer Zelle damit am einfachsten ist.

[mikele]

Hallo,,
um den Auswahlrahmen zu entfernen gibt es den Trick ein leeres Range-Objekt auszuwählen:

Code: Alles auswählen

oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
ThisComponent.CurrentController.Select(oRanges)

[Cepheus]

Hallo,
Um den Auswahlrahmen zu entfernen, habe ich nach

dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args4())

außer Dim oRanges noch deine 2 Codezeilen eingebaut, also:

Dim oRanges
oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
ThisComponent.CurrentController.Select(oRanges)

aber es hat nichts genutzt: der Rahmen läuft weiterhin.
Muss ich sonst noch was tun? Jedenfalls danke ich dir für deine Hilfe. Gruß,
Cepheus

[mikele]

Hallo,
probier mal am Ende noch folgende Dispatcherbefehle zu setzen

dispatcher.executeDispatch(document, ".uno:SetInputMode", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Cancel", "", 0, Array())

Wenn das Makro aus der Datei heraus (per Schaltfläche oder Makros->Ausführen) gestartet wird, funktioniert es, aus der IDE heraus nicht.