Get a custom color from the user
2005-03-01 Other 0 3395
The function below can be used to let the user pick or select a custom color. It uses the Excel applications own built in dialog for selecting colors. Unfortunately this built in dialog does not return a value for the color selected by the user. If the user selects a color in the dialog, it will update the active workbooks color palette with the selected color. Because of this limitation, the function below will not work there is not an active workbook. The function can also be used in a UserForm / dialog.
Function GetUserSelectedColor(Optional lngInitialColor As Long = 16777215) As Long
Dim lngResult As Long, lngO As Long, intR As Integer, intG As Integer, intB As Integer
lngResult = xlNone ' default function result
' this function requires that a workbook is active
If Not ActiveWorkbook Is Nothing Then
' save the original first palette color so it is possible to restore it
lngO = ActiveWorkbook.Colors(1)
' get the RGB values of lngInitialColor
intR = lngInitialColor And 255
intG = lngInitialColor \ 256 And 255
intB = lngInitialColor \ 256 ^ 2 And 255
If Application.Dialogs(xlDialogEditColor).Show(1, intR, intG, intB) = True Then
' the user selected a color and the first color in the palette was updated
lngResult = ActiveWorkbook.Colors(1)
' reset the changed palette color to the original color
ActiveWorkbook.Colors(1) = lngO
End If
End If
GetUserSelectedColor = lngResult
End Function
Here are a few examples:Sub ChangeCellColor()
Dim lngColor As Long
' lngColor = GetUserSelectedColor() ' no default color
lngColor = GetUserSelectedColor(ActiveCell.Interior.Color)
If lngColor <> xlNone Then
ActiveCell.Interior.Color = lngColor
End If
End Sub
Private Sub Label1_Click()
Dim c As Long
c = GetUserSelectedColor(Me.Label1.BackColor)
If c <> xlNone Then
Me.Label1.BackColor = c
End If
End Sub