VBA Farbähnlichkeit feststellen

18.12.2025 09:53:45

Joschi Witchcraft

Guten Morgen, Excel-Fans.

Ein Bekannter hält Schulungen bei der VHS und hatte dort ein Beispiel über eine UDF zur Ermittlung des Namens der Schriftfarbe eingesetzt, das er von einem anderen Kollegen bekommen hat. Er selbst hat keinerlei Erfahrungen mit VBA, wohl aber mit Excel.

Durch Aufruf der UDF mit Bezug zu einer bestimmten Zelle soll der Namen der verwendeten Schriftfarbe angezeigt werden. Dabei wird eine gewisse Toleranz eingehalten. Ich selbst habe mich noch nie intensiv mit den Farben beschäftigt. Zwar ist mir RGB ein Begriff, aber was der ähnlichste Code für vbRed wäre, ist mir unklar.

Aus dem Code: zuerst wird die Textfarbe in die Farben Rot, Grün und Blau zerlegt. Dann wird RGB aus einer internen Tabelle ermittelt.

In der Variable "WTVar" steht nach dem Farbcode im nächsten Element der zugehörige Name:
WTVar = Array(vbBlack, "Schwarz", vbWhite, "Weiss", vbRed + 5, "Rot", _
vbGreen, "Grün", RGB(255, 255, 0), "Gelb", vbMagenta, "Magenta")

For i = LBound(WTVar) To UBound(WTVar) Step 2
WTR = WTVar(i) Mod 256
WTG = (WTVar(i) \ 256) Mod 256
WTB = (WTVar(i) \ 65536) Mod 256
Distanz = Sqr(((r - WTR) ^ 2) + ((g - WTG) ^ 2) + ((b - WTB) ^ 2))
If Distanz MinDistanz Then
MinDistanz = Distanz
Index = i
End If
Next i

Dieser Code erkennt sowohl die Farbe "vbRed" als auch, wenn in der Tabelle "vbRed-10" definiert ist. Bei "vbRed + 10" versagt der Code.

Hat jemand eine bessere Lösung als die oben genannte mit Hilfe von Sqr?

Gruß Joschi

AW: Aber warum nur so'n Schnipsel ohne komplette Mappe???

18.12.2025 12:59:59

JoWE

AW: Aber warum nur so'n Schnipsel ohne komplette Mappe???

18.12.2025 15:54:43

Joschi Witchcraft

... weil die ganze Problematik in dem Code-Schnipsel steckt, und es einfacher ist, eine Code bereitzustellen als eine Mappe.

AW: VBA Farbähnlichkeit feststellen

18.12.2025 13:31:37

Yal

Hallo Joschi,

es ist ja fraglich, warum die festdefinierte Farbwerte vbRed & co zuerst in Einzelteil jedesmal berechnet werden. Es wäre hier sinnvoller, diese Konstanten in RGB-Teilung vorzugeben und dann die übergebene Farbe in seine RGB-Anteil zu zerstückeln.
Eine saubere Deklaration der Variable gehört -mMn- in einem guten Kurs dazu. Beispiele, wie man Code kommentiert, wäre auch nicht schlecht.

Es würde dann so aussehen:

Sub FarbeDistanz_berechnen(Farbe As Long)

Dim Ref as Variant

Dim i As Integer ' i ist eine Lauf-Variable, um die Anzahl von Schleifen (For ...) zu steuern. Lauf-Variable sind üblicherweise 1-stellig. Muss aber nicht.

Dim R&, G&, B& '& ist die Kurzform von "Long"

Dim Distanz As Double

    

    Ref = Array( _

        Array("Schwarz", 0, 0, 0), _

        Array("Weiss", 255, 255, 255), _

        Array("Rot", 255, 0, 0), _

        Array("Grün", 0, 255, 0), _

        Array("Gelb", 255, 255, 0), _

        Array("Magenta", 255, 0, 255))



    R = Farbe Mod 256

    G = (Farbe \ 256) Mod 256

    B = (Farbe \ 65536) Mod 256

    Debug.Print "Farbe: ", R, G, B, "-----" 'Einzelteil der übergegebenen Farbe werden angezeigt

    For i = LBound(Ref) To UBound(Ref)

        Distanz = Sqr(((R - Ref(i)(1)) ^ 2) + ((G - Ref(i)(2)) ^ 2) + ((B - Ref(i)(3)) ^ 2)) 'Pythagoras Hypotenuse-Berechnung = Distanz 

        Debug.Print Ref(i)(0), Ref(i)(1), Ref(i)(2), Ref(i)(3), Distanz 'einzelne Referenzfarbe werden in Einzelteil angezeigt und dazu die Distanz

    Next i

End Sub

Nur die Distanz wird innerhalb der Schleife (spricht "jedesmal") berechnet. Ausgabe findet hier in dem Direkt-Fenster (Menü Ansicht, Direkt-Fenster).
Man könnte noch hinzufügen, dass die Kürzeste Distanz ermittelt wird und nur diese herausgegeben wird.
Ok, Array of Array ist nicht unbedingt Anfänger-tauglich (nicht kompliziert an sich, aber zu viel verwässert das wichtigste).

Ein Test-Sub ist dazu notwendig, um die Farbe zu erzeugen:

Sub Test()

Dim i%, j% '% ist die Kurzform von "Integer"

Dim Farbe As Long



    For i = 1 To 5 'Anzahl von Test

        Farbe = 0

        For j = 0 To 2 '0: R, 1:G, 2:B

            Farbe = Farbe + WorksheetFunction.RandBetween(0, 255) ^ j

        Next

        FarbeDistanz_berechnen Farbe

    Next i

End Sub

Weitere Gedanken gehen dann in Richtung Objekt-Verwendung, aber auch nicht Anfänger-tauglich.

VG
Yal

AW: VBA Farbähnlichkeit feststellen

18.12.2025 16:44:33

Joschi Witchcraft

Hallo Yal.
Vielen Dank für Deinen Code.

Nur zum Verständnis: die Kurs-Teilnehmer erhalten diesen Code nicht. Er dient lediglich dazu, den Teilnehmen zu zeigen, wie man eine UDF in eine Tabelle einbinden kann, wobei sie mit der Schriftfarbe selbst eine Vorgabe machen können.

Ich finde den Aufbau der internen Tabelle in der ursprünglichen Fassung für sinnvoll, weil dabei nicht zu jeder Farbe der passende RGB-Code erforderlich ist. Gibt es keinen symbolischen Namen, dann kann der Wert auch als RGB eingegeben werden. Natürlichc wäre es auch denkbar, innerhalb des Array weitere Arrays anzulegen. Aber mein Bekannter hat - wie bereits erwähnt - fast Null Ahnung von VBA. Die interne Tabelle zu pflegen, dürfte für ihn noch machbar sein.

Wenn die RGB-Werte in der Tabelle nicht als Array sondern als Zahl hinterlegt sind, dann bleibt nur die Möglichkeit, den RGB-Wert für jeden Eintrag in einer Loop zu ermitteln.
Danke auch für den Hinweis, wie Variablen ein bestimmtes Format zugeordnet werden, ohne dass dies namentlich erwähnt wird. Mit "Integer" kann der Bekannte möglicherweise noch etwas anfangen. Ob er das mit "%" kann, ist eher fraglich.

Außer dem geänderten Aufbau der Tabelle und dem Ablauf sehe ich keinen großen Unterschied zwischen dem urspünglichen Code und Deinem.

Zurück zum ursprünglichen Problem:

Es war vermutlich keine gute Idee von mir, mit "vbRed + 5" oder "vbRed - 5" eine Farbe zu definieren, die "knapp vor oder hinter vbRed liegt".

Ich habe die Textfarbe nun über das Fenster mit der ganzen Farbpalette geändert, und dabei die links bzw. rechts der ursprünglichen Farbe stehende Farbe ausgewählt. In beiden Fällen konnte nicht ermittelt werden, dass es "nahe Rot" wäre. Kann es sein, dass solch eine Ermittlung gar nicht möglich ist??

Meinem Bekannten werde ich empfehlen, nur solche Farben in die Tabelle aufzunehmen, welche mit den "Standardfarben" eingestellt werden können. Dann kann auf "Sqr" verzichtet werden. Entweder ist der Farbcode in der Tabelle vorhanden, und als Ergebnis wird entweder der zugehörige Namen oder der RGB-Wert zurückgegeben,.

Gruß Joschi

PS: ich lasse vorerst den Thread noch offen.

AW: VBA Farbähnlichkeit feststellen

18.12.2025 21:02:39

Yal

Hallo Joschi,

"vbRot + 5" ist nicht korrekt: wenn Du in der Konsole (="Direktbereich")

?vbRed

eingibst und Enter, dann bekommst 255.
Wenn Du
?vbRed + 5
dann 260.
Diese 260 wird dann in RGB 4, 1, 0 herausgebrochen, was heisst: 4 / 255 Anteil an rot, und 1 / 255 Anteil an grün. Also sehr nah an Schwarz und weit entfernt von Rot.

Als "nah von rot" kann nur eine Farbe definiert werden, dessen rot-Anteil sehr hoch ist (ca. > 220) und die anderen Farb-Anteil sehr klein sind: grün 10, blau 10.
Daher der Distanz-Berechnung in 3-dimensionalen RGB-Raum.

Die Farbe an sich ist auch nicht kompliziert, aber die Schulung sollte sich auf das Verständnis der "Übergabe einer Aufgabe in Form von VBA-Code" konzentrieren. Solche Sonderfälle der RGB bringt zu viele Ablenkung.
(aber falls die Neugierigkeit vorhanden ist, handelt es sich bei RGB um ein Polymorphismus: Sache, die auf zwei verschiedene Art & Weise beschrieben werden können. Das gilt auch für Datum und Zeiten: 55 Min + 10 Min ergibt 65 Min, was auch 1 Std + 5 Min sind. Polymorphismus werden am besten mit Objekt-Programmierung behandelt, der 3te Eintrag "Klassenmodul" in dem Menü "Einfügen", nach "Userform" und "Modul". Gleichwohl der Polymorphismus von VBA sehr schwach implementiert ist: man muss alles selber kodieren)

VG
Yal

AW: VBA Farbähnlichkeit feststellen

18.12.2025 14:19:26

snb

Wozu werden die Farben benützt ?

AW: VBA Farbähnlichkeit feststellen

18.12.2025 18:36:00

schauan

... hier mal was mit der Zellfarbe. Sollte mit der Schriftfarbe genau so funktionieren. Ob man da RGB nimmt und zerlegt oder zusammensetzt oder gleich mit den Farben arbeitet, sei mal dahingestellt.
https://www.herber.de/bbs/user/179873.xlsm

AW: ... die Auflistung im Tabellenblatt ...

18.12.2025 21:06:16

schauan

... hat übrigens den Vorteil, dass man bei Erweiterung oder Kürzung der Liste resp. auszuwertenden Farben am Code nichts ändern muss ...

AW: VBA Farbähnlichkeit feststellen

18.12.2025 20:14:46

xlKing

Hallo Joschi,
Im Prinzip musst du nur die Colorindex-Eigenschaft auslesen, diese rundet die angezeigte Farbe auf den in der Palette am nächsten verfügbaren Wert. Dann kannst du die entsprechende Grundfarbe aus der Palette auslesen und deren Farbnamen wiedergeben. Die RGB-Werte und Namen müsstest du natürlich nochmal prüfen. Ist jetzt ein bisschen Denglisch geworden. Der Wert bezieht sich auf den Zellhintergrund. Für die Schriftfarbe ersetze das Wort Interior, durch Font. Das ist Alles.

Function Farbname(zelle As Range)

 Dim x As Long, y As Long

 x = zelle.Interior.ColorIndex

 If x = xlNone Then

   Farbname = "Keine Farbe"

 ElseIf x >= 1 And x = 56 Then

    y = ActiveWorkbook.Colors(x)

    Farbname = getFarbname(y)

 Else

    Farbname = "#Fehler!"

 End If

End Function



Function getFarbname(Clr As Long) As String

  

Select Case Clr

Case RGB(240, 248, 255)

  getFarbname = "aliceblue"

Case RGB(250, 235, 215)

  getFarbname = "AntiqueWhite"

Case RGB(0, 255, 255)

  getFarbname = "AQUA"

Case RGB(127, 255, 212)

  getFarbname = "Aquamarin"

Case RGB(240, 255, 255)

  getFarbname = "azure"

Case RGB(245, 245, 220)

  getFarbname = "Beige"

Case RGB(255, 228, 196)

  getFarbname = "BISQUE"

Case RGB(0, 0, 0)

  getFarbname = "Schwarz"

Case RGB(255, 235, 205)

  getFarbname = "blanchedalmond"

Case RGB(0, 0, 255)

  getFarbname = "Blau"

Case RGB(138, 43, 226)

  getFarbname = "BLUEVIOLET"

Case RGB(165, 42, 42)

  getFarbname = "Braun"

Case RGB(222, 184, 135)

  getFarbname = "Burlywood"

Case RGB(95, 158, 160)

  getFarbname = "CadetBlue"

Case RGB(127, 255, 0)

  getFarbname = "CHARTREUSE"

Case RGB(210, 105, 30)

  getFarbname = "Schokolade"

Case RGB(255, 127, 80)

  getFarbname = "Korallen"

Case RGB(100, 149, 237)

  getFarbname = "CornflowerBlue"

Case RGB(255, 248, 220)

  getFarbname = "CORNSILK"

Case RGB(220, 20, 60)

  getFarbname = "Crimson"

Case RGB(0, 255, 255)

  getFarbname = "cyan"

Case RGB(0, 0, 139)

  getFarbname = "DarkBlue"

Case RGB(0, 139, 139)

  getFarbname = "DARKCYAN"

Case RGB(184, 134, 11)

  getFarbname = "DarkGoldenRod"

Case RGB(169, 169, 169)

  getFarbname = "darkgray"

Case RGB(0, 100, 0)

  getFarbname = "DarkGreen"

Case RGB(169, 169, 169)

  getFarbname = "DARKGREY"

Case RGB(189, 183, 107)

  getFarbname = "DarkKhaki"

Case RGB(139, 0, 139)

  getFarbname = "darkmagenta"

Case RGB(85, 107, 47)

  getFarbname = "DarkOliveGreen"

Case RGB(255, 140, 0)

  getFarbname = "DARKORANGE"

Case RGB(153, 50, 204)

  getFarbname = "DarkOrchid"

Case RGB(139, 0, 0)

  getFarbname = "darkred"

Case RGB(233, 150, 122)

  getFarbname = "DarkSalmon"

Case RGB(143, 188, 143)

  getFarbname = "DARKSEAGREEN"

Case RGB(72, 61, 139)

  getFarbname = "DarkSlateBlue"

Case RGB(47, 79, 79)

  getFarbname = "darkslategray"

Case RGB(47, 79, 79)

  getFarbname = "DarkSlateGrey"

Case RGB(0, 206, 209)

  getFarbname = "DARKTURQUOISE"

Case RGB(148, 0, 211)

  getFarbname = "DarkViolet"

Case RGB(255, 20, 147)

  getFarbname = "deeppink"

Case RGB(0, 191, 255)

  getFarbname = "DeepSkyBlue"

Case RGB(105, 105, 105)

  getFarbname = "DIMGRAY"

Case RGB(105, 105, 105)

  getFarbname = "DimGrey"

Case RGB(30, 144, 255)

  getFarbname = "dodgerblue"

Case RGB(178, 34, 34)

  getFarbname = "FireBrick"

Case RGB(255, 250, 240)

  getFarbname = "FLORALWHITE"

Case RGB(34, 139, 34)

  getFarbname = "ForestGreen"

Case RGB(255, 0, 255)

  getFarbname = "fuchsia"

Case RGB(220, 220, 220)

  getFarbname = "Gainsboro"

Case RGB(248, 248, 255)

  getFarbname = "GHOSTWHITE"

Case RGB(255, 215, 0)

  getFarbname = "Gold"

Case RGB(218, 165, 32)

  getFarbname = "Goldenrod"

Case RGB(128, 128, 128)

  getFarbname = "Grau"

Case RGB(0, 128, 0)

  getFarbname = "GRÜN"

Case RGB(173, 255, 47)

  getFarbname = "GreenYellow"

Case RGB(128, 128, 128)

  getFarbname = "grau"

Case RGB(240, 255, 240)

  getFarbname = "Honeydew"

Case RGB(255, 105, 180)

  getFarbname = "HOTPINK"

Case RGB(205, 92, 92)

  getFarbname = "IndianRed"

Case RGB(75, 0, 130)

  getFarbname = "indigo"

Case RGB(255, 255, 240)

  getFarbname = "Ivory"

Case RGB(240, 230, 140)

  getFarbname = "KHAKI"

Case RGB(230, 230, 250)

  getFarbname = "Lavendel"

Case RGB(255, 240, 245)

  getFarbname = "Lavendelblush"

Case RGB(124, 252, 0)

  getFarbname = "LawnGreen"

Case RGB(255, 250, 205)

  getFarbname = "LEMONCHIFFON"

Case RGB(173, 216, 230)

  getFarbname = "LightBlue"

Case RGB(240, 128, 128)

  getFarbname = "lightcoral"

Case RGB(224, 255, 255)

  getFarbname = "LightCyan"

Case RGB(250, 250, 210)

  getFarbname = "lightgoldenrodyellow"

Case RGB(211, 211, 211)

  getFarbname = "LightGray"

Case RGB(144, 238, 144)

  getFarbname = "hellgrün"

Case RGB(211, 211, 211)

  getFarbname = "LightGrey"

Case RGB(255, 182, 193)

  getFarbname = "LIGHTPINK"

Case RGB(255, 160, 122)

  getFarbname = "LightSalmon"

Case RGB(32, 178, 170)

  getFarbname = "lightseagreen"

Case RGB(135, 206, 250)

  getFarbname = "LightSkyBlue"

Case RGB(119, 136, 153)

  getFarbname = "LIGHTSLATEGRAY"

Case RGB(119, 136, 153)

  getFarbname = "LightSlateGrey"

Case RGB(176, 196, 222)

  getFarbname = "lightsteelblue"

Case RGB(255, 255, 224)

  getFarbname = "LightYellow"

Case RGB(0, 255, 0)

  getFarbname = "LIME"

Case RGB(50, 205, 50)

  getFarbname = "LimeGreen"

Case RGB(250, 240, 230)

  getFarbname = "Bettwäsche"

Case RGB(255, 0, 255)

  getFarbname = "Magenta"

Case RGB(128, 0, 0)

  getFarbname = "MAROON"

Case RGB(102, 205, 170)

  getFarbname = "MediumAquamarin"

Case RGB(0, 0, 205)

  getFarbname = "mittelblau"

Case RGB(186, 85, 211)

  getFarbname = "MediumOrchid"

Case RGB(147, 112, 219)

  getFarbname = "MEDIUMPURPLE"

Case RGB(60, 179, 113)

  getFarbname = "MediumSeaGreen"

Case RGB(123, 104, 238)

  getFarbname = "mediumslateblue"

Case RGB(0, 250, 154)

  getFarbname = "MediumSpringGreen"

Case RGB(72, 209, 204)

  getFarbname = "MEDIUMTURQUOISE"

Case RGB(199, 21, 133)

  getFarbname = "MediumVioletRed"

Case RGB(25, 25, 112)

  getFarbname = "mitternachtsblau"

Case RGB(245, 255, 250)

  getFarbname = "MintCream"

Case RGB(255, 228, 225)

  getFarbname = "MISTYROSE"

Case RGB(255, 228, 181)

  getFarbname = "Moccasin"

Case RGB(255, 222, 173)

  getFarbname = "navajowhite"

Case RGB(0, 0, 128)

  getFarbname = "Marine"

Case RGB(253, 245, 230)

  getFarbname = "OLDLACE"

Case RGB(128, 128, 0)

  getFarbname = "Oliv"

Case RGB(107, 142, 35)

  getFarbname = "olivedrab"

Case RGB(255, 165, 0)

  getFarbname = "Orange"

Case RGB(255, 69, 0)

  getFarbname = "ORANGERED"

Case RGB(218, 112, 214)

  getFarbname = "Orchidee"

Case RGB(238, 232, 170)

  getFarbname = "Palegoldenrod"

Case RGB(152, 251, 152)

  getFarbname = "PaleGreen"

Case RGB(175, 238, 238)

  getFarbname = "PALETURQUOISE"

Case RGB(219, 112, 147)

  getFarbname = "PaleVioletRed"

Case RGB(255, 239, 213)

  getFarbname = "papayawhip"

Case RGB(255, 218, 185)

  getFarbname = "Pfirsichpuff"

Case RGB(205, 133, 63)

  getFarbname = "PERU"

Case RGB(255, 192, 203)

  getFarbname = "Rosa"

Case RGB(221, 160, 221)

  getFarbname = "Pflaume"

Case RGB(176, 224, 230)

  getFarbname = "PowderBlue"

Case RGB(128, 0, 128)

  getFarbname = "LILA"

Case RGB(255, 0, 0)

  getFarbname = "Rot"

Case RGB(188, 143, 143)

  getFarbname = "rosybrown"

Case RGB(65, 105, 225)

  getFarbname = "RoyalBlue"

Case RGB(139, 69, 19)

  getFarbname = "SATTELBROWN"

Case RGB(250, 128, 114)

  getFarbname = "Salmon"

Case RGB(244, 164, 96)

  getFarbname = "sandybrown"

Case RGB(46, 139, 87)

  getFarbname = "SeaGreen"

Case RGB(255, 245, 238)

  getFarbname = "SEASHELL"

Case RGB(160, 82, 45)

  getFarbname = "Sienna"

Case RGB(192, 192, 192)

  getFarbname = "Silber"

Case RGB(135, 206, 235)

  getFarbname = "SkyBlue"

Case RGB(106, 90, 205)

  getFarbname = "SLATEBLUE"

Case RGB(112, 128, 144)

  getFarbname = "SlateGray"

Case RGB(112, 128, 144)

  getFarbname = "Schiefergrün"

Case RGB(255, 250, 250)

  getFarbname = "Schnee"

Case RGB(0, 255, 127)

  getFarbname = "SPRINGGREEN"

Case RGB(70, 130, 180)

  getFarbname = "SteelBlue"

Case RGB(210, 180, 140)

  getFarbname = "tan"

Case RGB(0, 128, 128)

  getFarbname = "Teal"

Case RGB(216, 191, 216)

  getFarbname = "THISTLE"

Case RGB(255, 99, 71)

  getFarbname = "Tomaten"

Case RGB(64, 224, 208)

  getFarbname = "türkis"

Case RGB(238, 130, 238)

  getFarbname = "Violett"

Case RGB(245, 222, 179)

  getFarbname = "WEIZEN"

Case RGB(255, 255, 255)

  getFarbname = "Weiß"

Case RGB(245, 245, 245)

  getFarbname = "Whitesmoke"

Case RGB(255, 255, 0)

  getFarbname = "Gelb"

Case RGB(154, 205, 50)

  getFarbname = "YELLOWGREEN"

End Select

  

End Function

Gruß Mr. K.

AW: VBA Farbähnlichkeit feststellen

18.12.2025 20:18:59

xlKing

Jetzt sehe ich doch noch einen Fehler:

Ersetze ActiveWorkbook.Colors(x)
durch zelle.Parent.Parent.Colors(x)

Dann kannst du dich auch auf andere Arbeitsmappen beziehen, wenn diese geöffnet sind.

Gruß Mr. K.

AW: VBA Farbähnlichkeit feststellen

18.12.2025 23:23:38

Yal

Hallo K.

das finde ich interessant und inspirierend!

Ich habe die Idee aufgegriffen und umgedreht:
- die Liste der Referenzfarben wird in einer Tabelle reingepackt,
- es wird gegen jede einzelne Element eine Distanz berechnet,
- die minimale Distanz und der passende Element werden zur Seite gelegt,
- am Ende die Farbe von minimal-Distanz-Element herausgegeben

Dim FarbListe() As String

Dim FarbListe_istInit As Boolean



Sub FarbListe_initieren()

    If Not FarbListe_istInit Then FarbListe = Array( _

        "0,0,0,Schwarz", "0,0,128,Marine", "0,0,139,DarkBlue", "0,0,205,mittelblau", "0,0,255,Blau", "0,100,0,DarkGreen", "0,128,0,GRÜN", _

        "0,128,128,Teal", "0,139,139,DARKCYAN", "0,191,255,DeepSkyBlue", "0,206,209,DARKTURQUOISE", "0,250,154,MediumSpringGreen", "0,255,0,LIME", "0,255,127,SPRINGGREEN", _

        "0,255,255,AQUA", "0,255,255,cyan", "25,25,112,mitternachtsblau", "30,144,255,dodgerblue", "32,178,170,lightseagreen", "34,139,34,ForestGreen", "46,139,87,SeaGreen", _

        "47,79,79,darkslategray", "47,79,79,DarkSlateGrey", "50,205,50,LimeGreen", "60,179,113,MediumSeaGreen", "64,224,208,türkis", "65,105,225,RoyalBlue", "70,130,180,SteelBlue", _

        "72,61,139,DarkSlateBlue", "72,209,204,MEDIUMTURQUOISE", "75,0,130,indigo", "85,107,47,DarkOliveGreen", "95,158,160,CadetBlue", "100,149,237,CornflowerBlue", "102,205,170,MediumAquamarin", _

        "105,105,105,DIMGRAY", "105,105,105,DimGrey", "106,90,205,SLATEBLUE", "107,142,35,olivedrab", "112,128,144,SlateGray", "112,128,144,Schiefergrün", "119,136,153,LIGHTSLATEGRAY", _

        "123,104,238,mediumslateblue", "124,252,0,LawnGreen", "127,255,0,CHARTREUSE", "127,255,212,Aquamarin", "128,0,0,MAROON", "128,0,128,LILA", "128,128,0,Oliv", _

        "128,128,128,Grau", "128,128,128,grau", "135,206,235,SkyBlue", "135,206,250,LightSkyBlue", "138,43,226,BLUEVIOLET", "139,0,0,darkred", "139,0,139,darkmagenta", _

        "139,69,19,SATTELBROWN", "143,188,143,DARKSEAGREEN", "144,238,144,hellgrün", "147,112,219,MEDIUMPURPLE", "148,0,211,DarkViolet", "152,251,152,PaleGreen", "153,50,204,DarkOrchid", _

        "154,205,50,YELLOWGREEN", "160,82,45,Sienna", "165,42,42,Braun", "169,169,169,darkgray", "169,169,169,DARKGREY", "173,216,230,LightBlue", "173,255,47,GreenYellow", _

        "175,238,238,PALETURQUOISE", "176,196,222,lightsteelblue", "176,224,230,PowderBlue", "178,34,34,FireBrick", "184,134,11,DarkGoldenRod", "186,85,211,MediumOrchid", "188,143,143,rosybrown", _

        "189,183,107,DarkKhaki", "192,192,192,Silber", "199,21,133,MediumVioletRed", "205,92,92,IndianRed", "205,133,63,PERU", "210,105,30,Schokolade", "210,180,140,tan", _

        "211,211,211,LightGray", "211,211,211,LightGrey", "216,191,216,THISTLE", "218,112,214,Orchidee", "218,165,32,Goldenrod", "219,112,147,PaleVioletRed", "220,20,60,Crimson", _

        "220,220,220,Gainsboro", "221,160,221,Pflaume", "222,184,135,Burlywood", "224,255,255,LightCyan", "230,230,250,Lavendel", "233,150,122,DarkSalmon", "238,130,238,Violett", _

        "238,232,170,Palegoldenrod", "240,128,128,lightcoral", "240,230,140,KHAKI", "240,248,255,aliceblue", "240,255,240,Honeydew", "240,255,255,azure", "244,164,96,sandybrown", _

        "245,222,179,WEIZEN", "245,245,220,Beige", "245,245,245,Whitesmoke", "245,255,250,MintCream", "248,248,255,GHOSTWHITE", "250,128,114,Salmon", "250,235,215,AntiqueWhite", _

        "250,240,230,Bettwäsche", "250,250,210,lightgoldenrodyellow", "253,245,230,OLDLACE", "255,0,0,Rot", "255,0,255,fuchsia", "255,0,255,Magenta", "255,20,147,deeppink", _

        "255,69,0,ORANGERED", "255,99,71,Tomaten", "255,105,180,HOTPINK", "255,127,80,Korallen", "255,140,0,DARKORANGE", "255,160,122,LightSalmon", "255,165,0,Orange", _

        "255,182,193,LIGHTPINK", "255,192,203,Rosa", "255,215,0,Gold", "255,218,185,Pfirsichpuff", "255,222,173,navajowhite", "255,228,181,Moccasin", "255,228,196,BISQUE", _

        "255,228,225,MISTYROSE", "255,235,205,blanchedalmond", "255,239,213,papayawhip", "255,240,245,Lavendelblush", "255,245,238,SEASHELL", "255,248,220,CORNSILK", "255,250,205,LEMONCHIFFON", _

        "255,250,240,FLORALWHITE", "255,250,250,Schnee", "255,255,0,Gelb", "255,255,224,LightYellow", "255,255,240,Ivory", "255,255,255,Weiß")

    FarbListe_istInit = True

End Sub



Function Farbe_zuordnen(Zelle As Range)

Dim MinDist As Double

Dim RGB1

Dim Elt

Dim RGB2

Dim Dist As Double

Dim Naheste



    MinDist = 99999

    FarbListe_initieren

    With Zelle.Font

        RGB1 = Array(.Color Mod 256, (.Color \ 256) Mod 256, (.Color \ 65536) Mod 256)

    End With

    For Each Elt In FarbListe

        RGB2 = Split(Elt, ",")

        ReDim Preserve RGB2(0 To 2)

        Dist = Sqr(((RGB1(0) - CLng(RGB2(0))) ^ 2 + (RGB1(1) - CLng(RGB2(1))) ^ 2 + (RGB1(2) - CLng(RGB2(2))) ^ 2))

        If Dist  MinDist Then

            MinDist = Dist

            Naheste = Elt

        End If

        If Dist = 0 Then Exit For 'wir sparen uns den Rest

    Next

    Farbe_zuordnen = Split(Naheste, ",")(3)

End Function

VG
Yal

AW: Farbtabelle ...

18.12.2025 23:49:09

schauan

... hier wäre dann mal eine Farbtabelle für ein paar mehr Namen ;-) ...

https://www.farb-tabelle.de/de/farbtabelle.htm

AW: Farbtabelle ...

19.12.2025 11:48:20

Joschi Witchcraft

Schönen guten Morgen.

Ich möchte mich an diese Stelle bei allen bedanken, die zu meinem Problem etwas beigetragen haben. Es sind interessante Dinge erwähnt worden. Doch ein Hinweis hat mich nun zu einer brauchbaren Lösung geführt: Colorindex.

Ich ermittle nun sowohl den Color-Wert als auch den ColorIndex-Wert. Danach ermittle ich aus dem ColorIndex-Wert den zugehörigen Color-Wert. Wie man das macht, habe ich im Internet gefunden: ThisWorkbook.Colors(Cells(x, y).Font.ColorIndex)

Wenn der errechnete Wert mit dem Color-Wert identisch ist, dann ist es die Basis-Farbe, andernfalls "eine ähnliche".

Jetzt brauche ich nur noch eine Tabelle mit den Einträgen für die 56 Standard-Farben. Und wenn es für einen Index keinen Eintrag gibt, dann wird - wie bisher - der RGB-Wert ausgegeben.

Nun wünsche ich allen frohe und besinnliche Weihnachten und einen guten Rutsch (aber nicht auf der Straße oder dem Gehweg).

Gruß Joschi

AW: VBA Farbähnlichkeit feststellen

18.12.2025 20:40:04

xlKing

und unten fehlt noch

Case Else
getFarbname = "nicht definiert"

Solltest du diese Meldung erhalten, dann passt keiner der RGB-Codes zu der in der Standardfarbpalette hinterlegten Standardfarbe. In dem Fall musst du für diese Farbe noch einen Namen finden.

Gruß Mr. K.

AW: VBA Farbähnlichkeit feststellen

18.12.2025 15:01:50

snb

z.B

Function F_snb(it)

    sn = Array(vbBlack, vbBlue, vbCyan, vbGreen, vbMagenta, vbRed, vbWhite, vbYellow)

    sp = Split("vbBlack vbBlue vbCyan vbGreen vbMagenta vbRed vbWhite vbYellow")



    F_snb = sp(Application.Match(it.Interior.Color, sn, 0) - 1)

End Function

AW: VBA Farbähnlichkeit feststellen

18.12.2025 16:05:25

Joschi Witchcraft

das habe ich doch im Start-Thread beschrieben ....

VBA Farbähnlichkeit feststellen

Forumthread: VBA Farbähnlichkeit feststellen

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Farbähnlichkeit feststellen

Forumthread: VBA Farbähnlichkeit feststellen

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread