Zelle per Makro Farbe aus RGB-Werten zuweisen

[Masl75]

hallo fachleute,

ich möchte gern diesen code calc-konform übersetzen, aber ich scheitere sowohl an der Werteübergabe mycell -> Wert1/2/3


Sub Vorlagen_faerben()
Dim Zaehler As Integer
Dim Wert1 As Integer
Dim Wert2 As Integer
Dim Wert3 As Integer

myDoc = thisComponent
mySheet = myDoc.sheets(6)
'myCell = mySheet.getCellByPosition(0,0)


mycell = thisComponent.sheets(6).getcellbyposition(0,0)
'Solange der Wert in Spalte 1 nicht leer ist, wird die Schleife durchgeführt
for zaehler=8 to 89
'mycell = thisComponent.sheets(6).getcellbyposition(zaehler,189+1)
Wert1 = myCell.Value
mycell = thisComponent.sheets(6).getcellbyposition(zaehler,189+2)
Wert2 = myCell.Value
mycell = thisComponent.sheets(6).getcellbyposition(zaehler,189+3)
Wert3 = myCell.Value
Worksheets("Sheet7").Cells(Zaehler + 8, 199).Interior.Color = RGB(Wert1, Wert2, Wert3)
Zaehler = Zaehler + 1
next zaehler
End Sub

Wo liegt der Fehler, sofern das bei Calc überhaupt realisierbar ist...(?)

LG, Masl

[Stephan]

aber ich scheitere sowohl an der Werteübergabe mycell -> Wert1/2/3

Beispiel:

Code: Alles auswählen

ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(189+3, Zaehler+8).CellBackColor = RGB(Wert1, Wert2, Wert3)

Gruß
Stephan

[Masl75]

Hallo Stefan,

du bist der Beste! :-* Das funzt!!! *freu*

Jetzt ergibt sich "natürlich" (wie immer bei Newbies) eine Folgefrage... *scheinheiligguckt*

Kann man auf diese Weise auch gleich die auf der jeweiligen Musterzelle basierende Formatvorlage (Name = Zelltext) erstellen oder aktualisieren? Ein Makro zum löschen aller Formatvorlagen habe ich bereits...

LG, Masl

[Stephan]

z.B.:

Code: Alles auswählen

Sub test
	neuer_style("Mein_CellStyle", 10, 255, 10)
End Sub

Function neuer_style(s_name As String, Wert1 As Integer, Wert2 As Integer, Wert3 As Integer)
	cs = ThisComponent.StyleFamilies.getByName("CellStyles")
	neuer_zellstyle = ThisComponent.CreateInstance("com.sun.star.style.CellStyle")
	neuer_zellstyle.setName(s_name)
	cs.insertByName(s_name, neuer_zellstyle)
	cs.getByName(s_name).CellBackColor = RGB(Wert1, Wert2, Wert3)
End Function

Gruß
Stephan

[Masl75]

Hi Stefan,

machst du das beruflich oder woher geriert man derartiges Wissen?

Ich hab das, soweit ichs verstanden habe, mal etwas auf meine Bedürfnisse angepasst, allerdings produziert eine Zeile einen Fehler, den ich nicht gelöst bekomme (siehe Foto).

Wo habe ich etwas übersehen?

Hier nochmal der aktuelle Code vom Screenshot im Klartext:

Code: Alles auswählen

Sub Vorlagen_faerben()
Dim Zaehler As Integer
Dim Wert1   As Integer
Dim Wert2   As Integer
Dim Wert3   As Integer

myDoc = thisComponent
mySheet = myDoc.sheets(6)
mycell = thisComponent.sheets(6).getcellbyposition(0,0)

for zaehler=7 to 87 'Zeilen 8 bis 87

'Werte für die Hintergrundfarbe auslesen    	
	mycell = ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188+1, Zaehler) 'Spalte 188 (GF)
    BGWert1 = myCell.Value

   	mycell = ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188+2, Zaehler) 'Spalte 189 (GG)
    BGWert2 = myCell.Value

	mycell = ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188+3, Zaehler) 'Spalte 190 (GH)
    BGWert3 = myCell.Value

'Werte für die Schriftfarbe auslesen
    mycell = ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188+4, Zaehler) 'Spalte 191 (GI)
    FCWert1 = myCell.Value

    mycell = ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188+5, Zaehler) 'Spalte 192 (GJ)
    FCWert2 = myCell.Value

    mycell = ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188+6, Zaehler) 'Spalte 193 (GK)
    FCWert3 = myCell.Value

    ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188-1, Zaehler).CellBackColor = RGB(BGWert1, BGWert2, BGWert3)
    ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188-1, Zaehler).CharColor = RGB(FCWert1, FCWert2, FCWert3)
   	s_name=ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188-1, Zaehler).String & "a"
   	neuer_style(s_name, BGWert1, BGWert2, BGWert3, FCWert1, FCWert2, FCWert3)
next zaehler

End Sub


Function neuer_style(s_name As String, BGWert1 As Integer, BGWert2 As Integer, BGWert3 As Integer, _
FCWert1 as Integer, FCWert2 as Integer, FCWert3 as Integer)
	cs = ThisComponent.StyleFamilies.getByName("CellStyles")
	neuer_zellstyle = ThisComponent.CreateInstance("com.sun.star.style.CellStyle")
	neuer_zellstyle.setName(s_name)
	cs.insertByName(s_name, neuer_zellstyle)
	cs.getByName(s_name).CellBackColor = RGB(BGWert1, BGWert2, BGWert3)
	cs.getByName(s_name).CharColor = RGB(FCWert1, FCWert2, FCWert3)
End Function

[Stephan]

Wo habe ich etwas übersehen?

Ich sehe nichts. Überprüfe den Inhalt der Variable s_name, z.B. mittels:

Code: Alles auswählen

Msgbox s_name

direkt vor der Fehlerzeile

(es könnte auch ein Fehler in der ganz speziellen LO-Version sein, glaube ich aber nicht. In LO 5.1.6 läuft mein Code)

Gruß
Stephan

[Toxitom]

Hey,

Wo habe ich etwas übersehen?

ich halte die markierte Fehlerzeile für überflüssig. Der Name wird gesetzt mit der darunter liegenden Zeile - nämlich erst dann, wenn das Objekt der Sammlung hinzugefügt wird.

Allerdings bekomme ich hier mit LO 5.3.x keine Fehlermeldung... scheint also ins Leere zu laufen.

Eine Prüfung des Objektes neuer_zellstyle nach der Namenszuweisung ergibt aber keinen Erfolg. Es gibt noch keinen Namen;)

Also, kommentiere die Zeile einfach aus.

VG
Tom

[Masl75]

Überprüfe den Inhalt der Variable s_name ...

Hab ich darunter bereits gemacht. Der Fehler rührte aber daher, dass ich im Compiler (oder wie das Code-Dings heißt) vor dem F5-Drücken mit dem Cursor in der Funktion "stand".

Der Wert s_name wird, wenn man den Lauf aus der Sub startet, korrekt übergeben, allerdings gibts eine Zeile darunter bereits die nächste "Meldung": ein schnöder Punkt möchte mir etwas erklären, aber ich versteh ihn nicht :-/



LG, Marcel

[Masl75]

Prüfung des Objektes neuer_zellstyle nach der Namenszuweisung ergibt aber keinen Erfolg. Es gibt noch keinen Namen;)

Verstehe ich das richtig? Nach der Namenszuweisung gibt es (noch) keinen Namen? Das widerspricht "etwas" meinem Verständnis von Logik, und ein wenig davon habe ich, so glaubte ich bisher eigentlich immer, durch die Muttermilch abbekommen...(?) *kopfkratz*

Der Fehler mit der Punkt-Message taucht übrigens auch nach dem Auskommentieren der setName(s_name) Zeile auf...

LG, Masl

[Masl75]

hier mal ein screenshot... manchmal sieht der fachmann ja dort noch was, was dem laien entgeht...

[Toxitom]

Hey Marcel,

na, deine Fehlermeldung sagt doch schon alles:) Die Formatvorlage unter dem Namen existiert bereits....

Ein 2. Mal lässt sie sich nicht erzeugen. Jeder Name muss eindeutig sein!

Also ist Dein Makro wahrscheinlich einmal durchgelaufen (korrekt), die Vorlage wurde erzeugt. Beim 2. Lauf crashed es - normal.

Also müsstest Du in Deinen Code zunächst eine Abfrage einbauen, ob die Vorlage mit dem Namen "s_name" schon existiert und sie nur dann Erzeugen, wenn dies noch nicht der Fall ist.

VG Tom

[Masl75]

Vielen Dank für die Bestätigung! Genau so ist es: Als ich das "a", dass ich ja extra deshalb hinter den aus den Zellen ausgelesenen, zu verwendenden Namen der Vorlage schreiben ließ, durch ein "b" ersetzt hatte, lief es durch; beim nächsten Durchlauf wieder der selbe Fehler. Aus "b" mach "c", und es funktionierte erneut ein Mal...

Somit wusste ich, dass es grundsätzlich läuft und traute mich auch, das bereits vorhandene Makro zum Löschen aller existierenden FV zu starten. Danach dann ein Volldurchlauf mit Daumendrücken und ich konnte dank eingeblendeter FV-Anzeige (F11) richtiggehend zusehen, wie die FVn erstellt wurden.

Aaaalso, nochmal ein riesen-dickes Dankeschön an alle Mitwirkenden! Jetzt habe ich einen Status bei der FV-Thematik, auf dem ich variabel erweitern/aufbauen kann.

Vielen Dank und LG, Marcel

[Masl75]

Hallihallo,

ich muss doch nochmal stören, tut mir leid.

Nach kurzer Freude über das fehlerlose Durchlaufen des Makros wunderte ich mich, dass sich die anhand der erstellten Formatvorlagen mittels SVERWEIS je nach Wert einzufärbenden Zellen nicht färbten, obwohl die Referenzzellen (dort wo der SVERWEIS "nachschaut") korrekt formatiert werden. Klicke ich eine davon an, wird mir auch die passende/richtige FV in der FV-Liste angezeigt/markiert.

Klicke ich eine der mittels SVERWEIS einzufärbenden Zielzellen an, wird mir dort ebenfalls eine zugeordnete FV angezeigt, die zu erwartende Formatierung (Hintergrundfarbe, Schriftfarbe) bleibt jedoch aus.

Die Option "Modify"/"Ändern" in den FVn funktioniert leider nicht (es passiert einfach nichts, wenn ich es anklicke), sodass ich auch nicht prüfen kann, welche Formatierung dieser - oder auch jeder anderen - FV zugewiesen ist. Wende ich jedoch eine beliebige der erstellten FVn auf eine beliebige Testzelle an, wird mir zwar die korrekte Anwendung der FV bestätigt, eine Farbänderung ist jedoch ebenfalls nicht zu erkennen.

Daraus schließe ich, dass - aus welchen Gründen auch immer - zwar 81 FVn (40 für "rot", 40 für "blau") erstellt werden, die in/mit der Funktion "neuer_Style" zugewiesenen Formatattribute CellBackColor, CharColor und CharHeight jedoch nicht in der FV gespeichert werden.

Meine unschwer zu erkennende Frage ist nun an euch, woran das liegen könnte...(?)

Hier nochmal der aktuelle Code:

Code: Alles auswählen

Sub Vorlagen_faerben()
call VorlagenLoeschen
msgbox "Alle Vorlagen gelöscht. Zum Erstellen der neuen Vorlagen 'OK' drücken."
Dim Zaehler As Integer
Dim Wert1   As Integer
Dim Wert2   As Integer
Dim Wert3   As Integer

myDoc = thisComponent
mySheet = myDoc.sheets(6)
mycell = thisComponent.sheets(6).getcellbyposition(0,0)

for zaehler=7 to 87 'Zeilen 8 bis 87

'Werte für die Hintergrundfarbe auslesen    	
	mycell = ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188+1, Zaehler) 'Spalte 188 (GF)
    BGWert1 = myCell.Value

   	mycell = ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188+2, Zaehler) 'Spalte 189 (GG)
    BGWert2 = myCell.Value

	mycell = ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188+3, Zaehler) 'Spalte 190 (GH)
    BGWert3 = myCell.Value

'Werte für die Schriftfarbe auslesen
    mycell = ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188+4, Zaehler) 'Spalte 191 (GI)
    FCWert1 = myCell.Value

    mycell = ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188+5, Zaehler) 'Spalte 192 (GJ)
    FCWert2 = myCell.Value

    mycell = ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188+6, Zaehler) 'Spalte 193 (GK)
    FCWert3 = myCell.Value

    ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188-1, Zaehler).CellBackColor = RGB(BGWert1, BGWert2, BGWert3)
    ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188-1, Zaehler).CharColor = RGB(FCWert1, FCWert2, FCWert3)
   	s_name=ThisComponent.Sheets().getByName("Sheet7").getcellbyposition(188-1, Zaehler).String  '& "c"
   	neuer_style(s_name, BGWert1, BGWert2, BGWert3, FCWert1, FCWert2, FCWert3)
next zaehler
msgbox ("Ferdisch!")
End Sub


Function neuer_style(s_name As String, BGWert1 As Integer, BGWert2 As Integer, BGWert3 As Integer, _
FCWert1 as Integer, FCWert2 as Integer, FCWert3 as Integer)

	cs = ThisComponent.StyleFamilies.getByName("CellStyles")
	Dim neuerZellstyle
	neuerZellstyle = ThisComponent.CreateInstance("com.sun.star.style.CellStyle")
	neuerZellstyle.setName(s_name)
	with neuerZellstyle
		.CellBackColor = RGB(BGWert1, BGWert2, BGWert3)
		.CharColor = RGB(FCWert1, FCWert2, FCWert3)
		.CharHeight = "6"
	end with
	cs.insertByName(s_name, neuerZellstyle)
End Function

[Masl75]

Wäre es denn nicht möglich, eine neue FV anhand einer bereits im gewünschten Format existierenden Zelle zu erstellen...?

[Mondblatt24]

Hallo,
ist es.
Markiere die Zelle,
dann

MfG Peter.