AW: Namen der Farben?
16.06.2004 09:22:21
Josef Ehrensberger
Hallo Gerhard!
Lass mal laufen.
Sub Farben_Komplett()
' auf Grundlage von einem Code von Nepumuk
' ***** Ergänzung von Hajo
Dim Rot As Long, Grün As Long, Blau As Long, Wert As Long
Dim c As Long
Cells(1, 1) = "Farbe"
Cells(1, 2) = "Index"
Cells(1, 3) = "RGB - Rot"
Cells(1, 4) = "RGB - Grün"
Cells(1, 5) = "RGB - Blau"
Cells(1, 6) = "Farbname"
Cells(1, 7) = "Farbname Hex"
For c = 1 To 56
Cells(c + 1, 1).Interior.ColorIndex = c
Cells(c + 1, 2) = c
Wert = Cells(c + 1, 1).Interior.Color
On Error Resume Next
Rot = Wert Mod 256
Wert = (Wert - Rot) / 256
Grün = Wert Mod 256
Wert = (Wert - Grün) / 256
Blau = Wert Mod 256
' MsgBox Rot & ", " & Grün & ", " & Blau
' ***** Ergänzung Hajo
Cells(c + 1, 3) = Rot
Cells(c + 1, 4) = Grün
Cells(c + 1, 5) = Blau
Cells(c + 1, 6) = FarbName(c)
Cells(c + 1, 7) = FarbNr("A" & c + 1)
Next
End Sub
Function FarbName(FarbIndex As Long) As String
Dim Farbcode As Long
Farbcode = ActiveWorkbook.Colors(FarbIndex)
Select Case Farbcode
Case 0
FarbName = "Schwarz"
Case 16777215
FarbName = "Weiß"
Case 255
FarbName = "Rot"
Case 65280
FarbName = "Grelles Grün"
Case 16711680
FarbName = "Blau"
Case 65535
FarbName = "Gelb"
Case 16711935
FarbName = "Rosa"
Case 16776960
FarbName = "Türkis"
Case 128
FarbName = "Dunkelrot"
Case 32768
FarbName = "Grün"
Case 8388608
FarbName = "Dunkelblau"
Case 32896
FarbName = "Dunkelgelb"
Case 8388736
FarbName = "Violett"
Case 8421376
FarbName = "Blaugrün"
Case 12632256
FarbName = "Grau -25%"
Case 8421504
FarbName = "Grau -50%"
Case 16751001
FarbName = "Immergrün"
Case 6697881
FarbName = "Pflaume"
Case 13434879
FarbName = "Elfenbein"
Case 16777164
FarbName = "Helles Türkis"
Case 6684774
FarbName = "Dukelpurpur"
Case 8421631
FarbName = "Koralle"
Case 13395456
FarbName = "Meeresblau"
Case 16764108
FarbName = "Eisblau"
Case 8388608
FarbName = "Dunkelblau"
Case 16711935
FarbName = "Rosa"
Case 65535
FarbName = "Gelb"
Case 16776960
FarbName = "Türkis"
Case 8388736
FarbName = "Violett"
Case 128
FarbName = "Dnkelrot"
Case 8421376
FarbName = "Blaugrün"
Case 16711680
FarbName = "Blau"
Case 16763904
FarbName = "Himmelblau"
Case 16777164
FarbName = "Helles Türkis"
Case 13434828
FarbName = "Hellgrün"
Case 10092543
FarbName = "Hellgelb"
Case 16764057
FarbName = "Blassblau"
Case 13408767
FarbName = "Hellrosa"
Case 16751052
FarbName = "Lavendel"
Case 10079487
FarbName = "Gelbraun"
Case 16737843
FarbName = "Hellblau"
Case 13421619
FarbName = "Aquamarin"
Case 52377
FarbName = "Gelbgrün"
Case 52479
FarbName = "Gold"
Case 39423
FarbName = "Helles Orange"
Case 26367
FarbName = "Orange"
Case 10053222
FarbName = "Blaugrau"
Case 9868950
FarbName = "Grau - 40%"
Case 6697728
FarbName = "Dunkelblaugrün"
Case 6723891
FarbName = "Meeresgrün"
Case 13056
FarbName = "Dunkelgrün"
Case 13107
FarbName = "Olivgrün"
Case 13209
FarbName = "Braun"
Case 6697881
FarbName = "Pflaume"
Case 10040115
FarbName = "Indigoblau"
Case 3355443
FarbName = "Grau -80%"
Case Else
FarbName = "Farbskala"
End Select
End Function
Public
Function FarbNr(Zelle As String) As String
' von Klausimausi64
FarbNr = "&H" & Right("00000000" & Hex$(Range(Zelle).Interior.Color), 8) & "&"
End Function
Gruß Sepp