Get a custom color from the user
2005-03-01 Other 0 200
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 FunctionHere 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