Option Explicit
'***********************************************************************************
Sub FarbeTafelAusgeben()
->Anzahl der Zeilen, mit der die Farbpalette ausgegeben werden soll
Const c_ANZZEILEN = 28
Const c_OffsetSP_Nr = 0
Const c_OffsetSP_CIndex = 1
Const c_OffsetSP_CName = 2
Const c_ANZ_Offset = 3->Anzahl der auszugebenden Spalten pro Index
Dim sp As Long, z As Long, ind As Long, k As Long
Dim ws As Worksheet
If c_ANZZEILEN < 1 Then MsgBox c_ANZZEILEN < 1: Exit Sub
->In aktiver Mappe neues Blatt anlegen
Set ws = ActiveWorkbook.Worksheets.Add
For k = 1 To 56
For z = 1 To c_ANZZEILEN
ind = ((k - 1) * c_ANZZEILEN) + z
sp = (k - 1) * c_ANZ_Offset + 1
ws.Cells(z, sp + c_OffsetSP_Nr).Value = Nr.: & ind
ws.Cells(z, sp + c_OffsetSP_CIndex).Interior.ColorIndex = ind
ws.Cells(z, sp + c_OffsetSP_CName).Value = XlColorIndexAlsString(ind)
If ind = 56 Then GoTo AUFRAEUMEN->Palette hat nur 56 Einträge
Next
Next
AUFRAEUMEN:
Set ws = Nothing
End Sub
'***********************************************************************************
Private Function XlColorIndexAlsString(v_Colorindex As Variant) As String
If IsNull(v_Colorindex) Then XlColorIndexAlsString = undefiniert: Exit Function
Select Case v_Colorindex
Case xlColorIndexNone: XlColorIndexAlsString = keinen '-4142
Case xlColorIndexAutomatic: XlColorIndexAlsString = Automatik ->-4105
Case 1: XlColorIndexAlsString = Schwarz
Case 2: XlColorIndexAlsString = Weiß
Case 3: XlColorIndexAlsString = Rot
Case 4: XlColorIndexAlsString = Hellgrün
Case 5: XlColorIndexAlsString = Blau
Case 6: XlColorIndexAlsString = Gelb
Case 7: XlColorIndexAlsString = Rosa
Case 8: XlColorIndexAlsString = Türkis
Case 9: XlColorIndexAlsString = Dunkelrot
Case 10: XlColorIndexAlsString = Grün
Case 11: XlColorIndexAlsString = Dunkelblau
Case 12: XlColorIndexAlsString = Dunkelgelb
Case 13: XlColorIndexAlsString = Violett
Case 14: XlColorIndexAlsString = Seegrün
Case 15: XlColorIndexAlsString = Grau 25%
Case 16: XlColorIndexAlsString = Grau 50%
Case 17: XlColorIndexAlsString = Immergrün
Case 18: XlColorIndexAlsString = Pflaume
Case 19: XlColorIndexAlsString = Elfenbein
Case 20: XlColorIndexAlsString = Helltürkis
Case 21: XlColorIndexAlsString = Dunkelpurpur
Case 22: XlColorIndexAlsString = Koralle
Case 23: XlColorIndexAlsString = Meeresblau
Case 24: XlColorIndexAlsString = Eisblau
Case 25: XlColorIndexAlsString = Dunkelblau
Case 26: XlColorIndexAlsString = Rosa
Case 27: XlColorIndexAlsString = Gelb
Case 28: XlColorIndexAlsString = Türkis
Case 29: XlColorIndexAlsString = Violett
Case 30: XlColorIndexAlsString = Dunkelrot
Case 31: XlColorIndexAlsString = Seegrün
Case 32: XlColorIndexAlsString = Blau
Case 33: XlColorIndexAlsString = Himmelblau
Case 34: XlColorIndexAlsString = Helltürkis
Case 35: XlColorIndexAlsString = Pastellgrün
Case 36: XlColorIndexAlsString = Hellgelb
Case 37: XlColorIndexAlsString = Blaßblau
Case 38: XlColorIndexAlsString = Hellrosa
Case 39: XlColorIndexAlsString = Lavendel
Case 40: XlColorIndexAlsString = Gelbbraun
Case 41: XlColorIndexAlsString = Hellblau
Case 42: XlColorIndexAlsString = Aquablau
Case 43: XlColorIndexAlsString = Gelbgrün
Case 44: XlColorIndexAlsString = Gold
Case 45: XlColorIndexAlsString = Hellorange
Case 46: XlColorIndexAlsString = Orange
Case 47: XlColorIndexAlsString = Graublau
Case 48: XlColorIndexAlsString = Grau 40%
Case 49: XlColorIndexAlsString = Grünblau
Case 50: XlColorIndexAlsString = Meeresgrün
Case 51: XlColorIndexAlsString = Dunkelgrün
Case 52: XlColorIndexAlsString = Olivgrün
Case 53: XlColorIndexAlsString = Braun
Case 54: XlColorIndexAlsString = Pflaume
Case 55: XlColorIndexAlsString = Indigoblau
Case 56: XlColorIndexAlsString = Grau 80%
Case Else: XlColorIndexAlsString = unbekannt( & CLng(v_Colorindex) & )
End Select
End Function
