Autor: Uwe Küstner  --- Aus Excel VBA - Gruppe: Verschiedenes

Spielerei 3: SchemeColor

Autor: Uwe Küstner - Erstellt: --      - Letzte Revision: --SchemeColor-Eigenschaft

Um Objekte farbig zu gestalten, kann man sich der RGB-Eigenschaft oder aber der SchemeColor-Eigenschaft bedienen.
Doch was beinhaltet die SchemeColor-Eigenschaft?
Das Einzige, was die VBA-Onlinehilfe dazu hergibt, ist diese eine Zeile:

Gibt die Farbe eines Color-Objekts als Index der aktuellen Farbskala zurück oder legt die Farbe fest. Long Schreib-Lese-Zugriff.

Doch welche Nummer entspricht welcher Farbe und wieviele Nummern gibt es?
Dazu habe ich mir nun ein Makro geschrieben, welches in einer neuen Mappe
die Farben mit zugehöriger Nummer ausgibt.
Dabei stellte ich fest, das es 80 Nummern gibt.

Nun hat die Probiererei endlich ein Ende. 

Sub SchemeColorUebersicht()
 ' Erstellt in einer neuen Arbeitsmappe eine Übersicht der
 ' SchemeColor-Nummern mit zugehöriger Farbe.
 ' Uwe Küstner 20061212
 Dim iColor As Byte, iX As Byte, iY As Byte, iZ As Byte
 Dim lngRed As Long, lngGreen As Long, lngBlue As Long
 Dim rngB As Range
 Application.ScreenUpdating = False
 Workbooks.Add xlWBATWorksheet
 ActiveSheet.Name = "SchemeColors"
 For iY = 2 To 31 Step 3
 For iX = 2 To 25 Step 3
  iColor = iColor + 1
  Set rngB = Range(Cells(iY, iX), Cells(iY + 2, iX + 2))
  With ActiveSheet.Shapes.AddShape(msoShapeBevel, rngB.Left, rngB.Top, _
   rngB.Width, rngB.Height)
  With .Fill
   .ForeColor.SchemeColor = iColor
   lngRed = (.ForeColor And vbRed)
   lngGreen = (.ForeColor And vbGreen) \ &H100
   lngBlue = (.ForeColor And vbBlue) \ &H10000
  End With
  iZ = _
   (((0.3 * lngRed) + (0.59 * lngGreen) + (0.11 * lngBlue)) < 150) * -255
  .Line.Visible = msoFalse
  With .TextFrame
   .Characters.Text = "SchemeColor: " & iColor & vbLf & _
     "RGB(" & lngRed & ", " & lngGreen & ", " & lngBlue & ")" & _
     vbLf & "Hex: &H" & _
     Format(Hex(lngRed), "00") & _
     Format(Hex(lngGreen), "00") & _
     Format(Hex(lngBlue), "00") & ""
   .Characters.Font.Name = "Tahoma"
   .Characters.Font.Size = 7
   .Characters.Font.Color = RGB(iZ, iZ, iZ)
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
  End With
  End With
 Next iX
 Next iY
 Cells.ColumnWidth = 4.5
 Cells.RowHeight = 13
 Rows(1).RowHeight = 6
 Application.ScreenUpdating = True
End Sub


Weitere Artikel der Gruppe: Verschiedenes Aus Excel VBA
Nach oben
ToDo
Google Werbung