Function CellColorIndex(InRange As Range, Optional _
OfText As Boolean = False) As Integer
'
' This function returns the ColorIndex value of a the Interior
' (background) of a cell, or, if OfText is true, of the Font in the cell.
'
Application.Volatile True
If OfText = True Then
CellColorIndex = InRange(1, 1).Font.ColorIndex
Else
CellColorIndex = InRange(1, 1).Interior.ColorIndex
End If
End Function
Hap said:Thank you for the function. That is kinda cool.
I have been using VBA and I cannot find any reference to the actual color index values.
Sub colors()
For i = 1 To 56
With Cells(i, "A")
.Interior.ColorIndex = i
.Value = i
.HorizontalAlignment = xlCenter
.Font.Color = vbWhite
.Font.Bold = True
End With
Next i
End Sub
Function CellColor(myCell As Range, Optional ColorIndex As Boolean)
Dim myColor As String, IndexNum As Integer
Select Case myCell.Interior.ColorIndex
Case 1
myColor = "Black"
IndexNum = 1
Case 2
myColor = "White"
IndexNum = 2
Case 3
myColor = "Red"
IndexNum = 3
Case 4
myColor = "Bright Green"
IndexNum = 4
Case 5
myColor = "Blue"
IndexNum = 5
Case 6
myColor = "Yellow"
IndexNum = 6
Case 7
myColor = "Pink"
IndexNum = 7
Case 8
myColor = "Turquoise"
IndexNum = 8
Case 9
myColor = "Dark Red"
IndexNum = 9
Case 10
myColor = "Green"
IndexNum = 10
Case 11
myColor = "Dark Blue"
IndexNum = 11
Case 12
myColor = "Dark Yellow"
IndexNum = 12
Case 13
myColor = "Violet"
IndexNum = 13
Case 14
myColor = "Teal"
IndexNum = 14
Case 15
myColor = "Gray-25%"
IndexNum = 15
Case 16
myColor = "Gray-50%"
IndexNum = 16
Case 33
myColor = "Sky Blue"
IndexNum = 33
Case 34
myColor = "Light Turquoise"
IndexNum = 34
Case 35
myColor = "Light Green"
IndexNum = 35
Case 36
myColor = "Light Yellow"
IndexNum = 36
Case 37
myColor = "Pale Blue"
IndexNum = 37
Case 38
myColor = "Rose"
IndexNum = 38
Case 39
myColor = "Lavender"
IndexNum = 39
Case 40
myColor = "Tan"
IndexNum = 40
Case 41
myColor = "Light Blue"
IndexNum = 41
Case 42
myColor = "Aqua"
IndexNum = 42
Case 43
myColor = "Lime"
IndexNum = 43
Case 44
myColor = "Gold"
IndexNum = 44
Case 45
myColor = "Light Orange"
IndexNum = 45
Case 46
myColor = "Orange"
IndexNum = 46
Case 47
myColor = "Blue-Gray"
IndexNum = 47
Case 48
myColor = "Gray-40%"
IndexNum = 48
Case 49
myColor = "Dark Teal"
IndexNum = 49
Case 50
myColor = "Sea Green"
IndexNum = 50
Case 51
myColor = "Dark Green"
IndexNum = 51
Case 52
myColor = "Olive Green"
IndexNum = 52
Case 53
myColor = "Brown"
IndexNum = 53
Case 54
myColor = "Plum"
IndexNum = 54
Case 55
myColor = "Indigo"
IndexNum = 55
Case 56
myColor = "Gray-80%"
IndexNum = 56
Case Else
myColor = "Custom color or no fill"
End Select
'if the index number is desired or if the cell color was not
'returned return the index number
If ColorIndex = True Or myColor = "Custom color or no fill" Then
CellColor = IndexNum
Else
CellColor = myColor
End If
End Function
Book1.xls | |||||||||
---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | |||
1 | 1 | Black | 1 | 37 | Pale Blue | 37 | |||
2 | 2 | White | 2 | 38 | Rose | 38 | |||
3 | 3 | Red | 3 | 39 | Lavender | 39 | |||
4 | 4 | Bright Green | 4 | 40 | Tan | 40 | |||
5 | 5 | Blue | 5 | 41 | Light Blue | 41 | |||
6 | 6 | Yellow | 6 | 42 | Aqua | 42 | |||
7 | 7 | Pink | 7 | 43 | Lime | 43 | |||
8 | 8 | Turquoise | 8 | 44 | Gold | 44 | |||
9 | 9 | Dark Red | 9 | 45 | Light Orange | 45 | |||
10 | 10 | Green | 10 | 46 | Orange | 46 | |||
11 | 11 | Dark Blue | 11 | 47 | Blue-Gray | 47 | |||
12 | 12 | Dark Yellow | 12 | 48 | Gray-40% | 48 | |||
13 | 13 | Violet | 13 | 49 | Dark Teal | 49 | |||
14 | 14 | Teal | 14 | 50 | Sea Green | 50 | |||
15 | 15 | Gray-25% | 15 | 51 | Dark Green | 51 | |||
16 | 16 | Gray-50% | 16 | 52 | Olive Green | 52 | |||
17 | 33 | Sky Blue | 33 | 53 | Brown | 53 | |||
18 | 34 | Light Turquoise | 34 | 54 | Plum | 54 | |||
19 | 35 | Light Green | 35 | 55 | Indigo | 55 | |||
20 | 36 | Light Yellow | 36 | 56 | Gray-80% | 56 | |||
Sheet17 |
Sub ShowRGBNoColorComponents()
'This macro prompts for an RGB color number, then displays
'the three RGB color component.
Dim Red%, Green%, Blue%, Msg$, RGBNo&, Title$
Title = "ShowConvertRGBNoToComponents"
Msg = "Enter the value of the RGB color number to be converted:"
RGBNo = Application.InputBox(Msg, Title, Default:=0, Type:=1) 'Returns a boolean or string
Red = RGBNo And 255
Green = RGBNo \ 256 And 255
Blue = RGBNo \ 256 ^ 2 And 255
Msg = "The color components of RGB number '" & RGBNo & "' are:" & vbCr & _
" Red = '" & Red & "' Green = '" & Green & "' Blue = '" & Blue & "'"
MsgBox Msg, , Title
End Sub 'ShowRGBNoColorComponents'
Sub ShowCellRGBColorComponents_Locator()
Call ShowCellRGBColorComponents("F")
End Sub
Sub ShowCellRGBColorComponents(Optional FontOrInterior$ = "F") '9/16/05
'This macro looks at the font or interior color of the currently
'selected cell, then displays all of the RGB color components.
'Arg "FontOrInterior" must have a value of "F" or "I",
'which determines if the font or the interior color is examined.
Dim Msg$, RGBColorNo&, ColorName$, R%, G%, B%
Const Title$ = "ShowColorRGBComponents"
If Left(UCase(FontOrInterior), 1) = "F" _
Then
RGBColorNo = ActiveCell.Font.Color
FontOrInterior = "font"
Else
RGBColorNo = ActiveCell.Interior.Color
FontOrInterior = "interior"
End If
R = RGBColorNo And 255
G = RGBColorNo \ 256 And 255
B = RGBColorNo \ 256 ^ 2 And 255
Select Case RGBColorNo
Case 0: ColorName = "Black or 'No Color'"
Case 16777215: ColorName = "White"
Case 255: ColorName = "Red"
Case 65280: ColorName = "Green"
Case 65535: ColorName = "Yellow"
Case 16711680: ColorName = "Blue"
Case 14423060: ColorName = "DkBlue"
Case 16711935: ColorName = "Magenta"
Case 16776960: ColorName = "Cyan"
Case Else: ColorName = "Unknown"
End Select
Msg = "For cell '" & ActiveCell.Address(False, False) & "'" & vbCr & _
"the RGB " & FontOrInterior & " color number is" & vbCr & _
Space(5) & "'" & RGBColorNo & "' (" & ColorName & ")." & vbCr & vbCr & _
"The RGB " & FontOrInterior & " color component" & vbCr & _
"numbers are:" & vbCr & _
Space(5) & "Red = '" & R & "'" & vbCr & _
Space(5) & "Green = '" & G & "'" & vbCr & _
Space(5) & "Blue = '" & B & "'" & vbCr & vbCr & _
"Standard RGB color numbers" & vbCr & _
"are:" & vbCr & _
Space(3) & "'No Color' is 0" & vbCr & _
Space(3) & "Black is 0" & vbCr & _
Space(3) & "White is 16777215" & vbCr & _
Space(3) & "Red is 255" & vbCr & _
Space(3) & "Green is 65280" & vbCr & _
Space(3) & "Yellow is 65535" & vbCr & _
Space(3) & "Blue is 16711680" & vbCr & _
Space(3) & "DkBlue is 14423060" & vbCr & _
Space(3) & "Magenta is 16711935" & vbCr & _
Space(3) & "Cyan is 16776960"
MsgBox Msg, , Title
End Sub 'ShowCellRGBColorComponents'