Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA: RGB()-Funktion ... nicht wie im Netz beschrieben...?
#1
Hi,
bei meinen Versuchen zur Gestaltung eines Diagramms via VBA bin ich auf ein Problem mit der RGB-Berechnung gestoßen:
  • die VBA-Funktion RGB(R,G,B) (mit R, G, B den Zahlen für Rot, Grün und Blau respektive, jeweils 0 ... 255) liefert einen Farbwert in Excel (z.B. zum Einstellen der Farbe einer Digramm-Linie, etc)
  • wenn ich aber jetzt ein Objekt (Linie, Zelle, ...) habe und die R, G und B-Komponenten dessen RGB-Farbwerts ermitteln will (also der 'umgekehrte' Weg...), dann habe ich dafür keine Formel gefunden: z.B. liefert das Attribut "[Objekt].Format.Line.ForeColor.RGB" nur eine dezimale Zahl
  • auf der Seite RGB Color Codes Chart steht die Formel: RGB = (R*65536)+(G*256)+B (irgendwo anders habe ich dieselbe Formel ebenfalls gesehen, weiß aber nicht mehr, wo), mit der angeblich der dezimale R-G-B-Wert berechnet wird
  • meine Tests haben aber ergeben, dass die Formel FALSCH ist: RGB = R+(G*256)+(B*65536) ergibt den richtigen Wert (dass die Klammern um die Multiplikationen mathematisch überflüssig sind, ist mir bekannt...)
  • und die inverse Berechnung (also die Berechnung der dezimalen R, G und B-Werte) kann erfolgen mit
(Wenn "rgb" der dezimale Farbwert ist und x = 65536 (2^16: zweites Byte) sowie y=256 (2^8: rechtes Byte) die binären Faktoren, dann)
  • B = rgb \ x                    (man beachte die Ganzzahl-Division mit "\" anstelle der 'normalen' Division "/")
  • G = (rgb - B*x) \ y        (alternativ: (rgb mod x) \ y )
  • R = rgb - B*x - G*y       (alternativ: (rgb mod x) mod y)
Auch die Umwandlung des rgb-Wertes in die Hex-Darstellung hilft weiter: h = HEX(rgb).
Dann muss dieser HEX-Wert von rechts betrachtet werden: jeweils zwei Ziffern (hexadezimal: 0-9 oder A-F) entsprechen einer der RGB-Komponenten mit R der am weitesten rechts stehende Wert, G der Wert in der Mitte und B den verbleibenden Stellen am linken Ende (ist B<16 dann nur eine Stelle, ansonsten zwei).
Dementsprechend sind dann
  • R = Val("&H" & Right(h,2))                         (wie gesagt: h ist der HEX-Wert von rgb)
  • G = Val("&H" & Mid(h,3-(6-Len(h)),2))
  • B = Val("&H" & Left(h, Len(h)-4)) 
Der Term "Len(h)" muss rein, weil bei einstelligen Hex-Werten für B die Hex-Darstellung von rgb nur 5 Stellen hat und somit der B-Wert in der äußerst linken Position nur einstellig ist.

Würde mich mal interessieren, ob es 'geschicktere' Varianten gibt. Insbesondere die falsche Formel auf der oben verlinkten Seite hat mir Einiges an Kopfzerbrechen bereitet...

Gruß,
RaiSta
 Man(n) ist nie zu alt für die Erkenntnis, dass das bisher Gelernte doch nur bedingt gültig oder auch nur brauchbar ist. 27
Antworten Top
#2
Code:
Sub M_snb()
   y = RGB(234, 20, 177)
   sn = Array(Application.Hex2Dec(Right(Hex(y), 2)), Application.Hex2Dec(Mid(Hex(y), 3, 2)), Application.Hex2Dec(Left(Hex(y), 2)))
   MsgBox sn(0) & vbLf & sn(1) & vbLf & sn(2)
  
   sn = Array(y Mod 256, (y Mod 256 ^ 2) \ 256, y \ 256 ^ 2)
   MsgBox sn(0) & vbLf & sn(1) & vbLf & sn(2)
End Sub
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
[-] Folgende(r) 1 Nutzer sagt Danke an snb für diesen Beitrag:
  • RaiSta
Antworten Top
#3
(13.04.2023, 18:35)snb schrieb:
Code:
Sub M_snb()
   y = RGB(234, 20, 177)
   sn = Array(Application.Hex2Dec(Right(Hex(y), 2)), Application.Hex2Dec(Mid(Hex(y), 3, 2)), Application.Hex2Dec(Left(Hex(y), 2)))
   MsgBox sn(0) & vbLf & sn(1) & vbLf & sn(2)
  
   sn = Array(y Mod 256, (y Mod 256 ^ 2) \ 256, y \ 256 ^ 2)
   MsgBox sn(0) & vbLf & sn(1) & vbLf & sn(2)
End Sub

Hi snb,
Danke für Deine Version. Deine erste Variante liefert allerdings für B<16 falsche Ergebnisse, denn dann ist die Hex-Darstellung von y nur 5-stellig...
Daher die kleine Überarbeitung:
Code:
SN = Array(Application.Hex2Dec(Right(Hex(Y), 2)), Application.Hex2Dec(Mid(Hex(Y), 3, 2)), Application.Hex2Dec(Left(Hex(Y), 2 - (6 - Len(Hex(Y))))))

... die Funktion Application.Hex2Dec war mir nicht bekannt - oder ich hatte sie wieder vergessen... Deine zweite Variante entspricht ja im Wesentlichen einem meiner Ansätze, von Dir allerdings schön in die Array-Funktion eingebettet...

Gruß und Dank,
RaiSta
 Man(n) ist nie zu alt für die Erkenntnis, dass das bisher Gelernte doch nur bedingt gültig oder auch nur brauchbar ist. 27
Antworten Top
#4
Hier noch eine Variante:

Code:
   
    c = RGB(16, 0, 0)
   
    c_h = Right("000000" & Hex(c), 6)
   
   
    r = Application.Hex2Dec(Mid$(c_h, 5, 2))
    g = Application.Hex2Dec(Mid$(c_h, 3, 2))
    b = Application.Hex2Dec(Mid$(c_h, 1, 2))
   
    MsgBox ("r/g/b = " & r & "/" & g & "/" & b)
Antworten Top
#5
Nur zur Info, man kann statt Worksheetfunction.Hex2Dec auch die VBA-Interne Typkonversion nutzen, um Hex in Dez umzurechnen:
Code:
Debug.print CInt("&hAFFE")
Debug.print CLng("&hAFFE")
r = CInt("&h" & Mid$(c_h, 5, 2))
Gruß
Michael
Antworten Top
#6
Der Vollständigkeit halber noch eine Version mit Bitmasken und Bitverschiebung:
Code:
y = rgb(234, 20, 177)
g = (y And 16711680) \ 2 ^ 16   ' Binär 11111111 00000000 00000000 / Hex FF 00 00 / Dez 16711680  /  Verschiebung um 16 Bit nach rechts
b = (y And 5120) \ 2 ^ 8        ' Binär 00000000 11111111 00000000 / Hex 00 FF 00 / Dez 5120   /  Verschiebung um 8 Bit nach rechts
r = y And &HFF                  ' Binär 00000000 00000000 11111111 / Hex 00 FF 00 / Dez 255   /  Verschiebung um 0 Bit nach rechts
Gruß
Michael
Antworten Top
#7
(14.04.2023, 11:47)Der Steuerfuzzi schrieb: [...]Version mit Bitmasken und Bitverschiebung:
Schöne Variante! Anstelle 5120 müsste aber doch 65280 stehen, also 2^16 - 2^8?
Die Variablen sind zudem noch vertauscht. 

Code:
Option Explicit
Sub test()
Dim y As Long: y = RGB(14, 123, 1)
Dim r As Byte, g As Byte, b As Byte

b = (y And 2 ^ 24 - 2 ^ 16) / 2 ^ 16
g = (y And 2 ^ 16 - 2 ^ 8) / 2 ^ 8
r = y And 2 ^ 8 - 2 ^ 0

Tabelle1.Range("A1").Interior.Color = y
Tabelle1.Range("B1").Resize(, 3).Value = Array(r, g, b)
End Sub
Bei der angepassten Version bleibt man in "Binärdenke" - das finde ich einfacher als der Wechsel zu Hex-Zahlen
Antworten Top
#8
@Earl Fred: Danke für den Hinweis. ja, da war Blau und Grün vertauscht und bei der zweiten Bitmaske habe ich per Copy&Paste den falschen Wert übernommen, Hex und Binär im Kommentar stimmen aber. Hier nochmal der korrekte Code:
Code:
y = RGB(234, 20, 177)
b = (y And 16711680) \ 2 ^ 16   ' Binär 11111111 00000000 00000000 / Hex FF 00 00 / Dez 16711680  /  Verschiebung um 16 Bit nach rechts
g = (y And 65280) \ 2 ^ 8        ' Binär 00000000 11111111 00000000 / Hex 00 FF 00 / Dez 65280   /  Verschiebung um 8 Bit nach rechts
r = y And &HFF                  ' Binär 00000000 00000000 11111111 / Hex 00 FF 00 / Dez 255   /  Verschiebung um 0 Bit nach rechts
Gruß
Michael
Antworten Top
#9
(14.04.2023, 20:16)Der Steuerfuzzi schrieb: [...]Hex und Binär im Kommentar stimmen aber. Hier nochmal der korrekte Code:
Code:
<Zeile 1>
<Zeile 2>
r = y And &HFF                  ' Binär 00000000 00000000 11111111 / Hex 00 FF 00 / Dez 255   /  Verschiebung um 0 Bit nach rechts

"... Binär im Kommentar stimmen " ... nicht: die letzte Zeile muss im Kommentar lauten:
' Binär 00000000 00000000 11111111 / Hex 00 00 FF / Dez 255  /  Verschiebung um 0 Bit nach rechts (ok, trivial, eigentlich 'Kosmetik'...)

ANSONSTEN: absolut geile Varianten, die sich dem Problem gewissermaßen 'an der Wurzel' annehmen, denn die RGB-Werte sind ja nix anderes als Byte-Kombinationen und mein 'banaler' Ansatz hat das Thema eher verschleiert als aufgeklärt.

Bleibt mir noch eine Frage: @Earl Fred hat die normale Division verwendet, Michael dagegen die Integer-Division. Bei meinen Tests habe ich bei Werten festgestellt, in denen das erste oder die ersten beiden Byte = 0 sind, mit "/" und "\" zu verschiedenen Ergebnissen kommt - hier scheint mir die Integer-Division die 'richtige' Wahl zu sein...

die Idee von Norbert:
(14.04.2023, 10:37)daNorbert schrieb:
Code:
c = RGB(16, 0, 0)
c_h = Right("000000" & Hex(c), 6)
zur Sicherstellung, dass die Hex-Darstellung auch immer 6-stellig ist, ist auch sehr schön.


Vielen Dank für Eure Beiträge, habe wieder 'ne Menge gelernt dabei!
Gruß,
RaiSta
 Man(n) ist nie zu alt für die Erkenntnis, dass das bisher Gelernte doch nur bedingt gültig oder auch nur brauchbar ist. 27
Antworten Top
#10
(15.04.2023, 11:35)RaiSta schrieb: Bei meinen Tests habe ich bei Werten festgestellt, in denen das erste oder die ersten beiden Byte = 0 sind, mit  "/" und "\" zu verschiedenen Ergebnissen kommt - hier scheint mir die Integer-Division die 'richtige' Wahl zu sein...
Ein konkretes Beispiel wäre mir recht.

Der RGB-Wert wird wie folgt ermittelt: R*2^0+G*2^8+B*2^16

Will man z. B. an den B-Wert, eliminiert man mittels (RGB And 2 ^ 24 - 2 ^ 16)  zuerst die unrelevanten Bytes. Übrig bleibt der "B-Anteil", der ein Vielfaches von 2^16 ist. Es ist daher unerheblich, welchen Operator man nimmt, da das Ergebnis, wenn man durch 2 ^ 16 teilt, folglich immer ganzzahlig sein muss. Die Unterschiede der beiden Operatoren bei nicht-ganzzahligen Ergebnissen spielen daher keine Rolle. 

Andere Methoden, wie die eingangs von dir gezeigte erste, "bereinigen" den RGB-Wert hingegen nicht von anderen Wertanteilen vor der Division, es wird also mit Rest geteilt. Hier muss der "\"-Operator für um Nachkommastellen gekürzte Division genutzt werden, da bei ungekürzter Division im Falle der regelkonformen Aufrundung auf ganzzahlige Ergebnisse falsche Ergebnisse entstehen.
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste