Get a custom color from the user

 2005-03-01    Other    0    69

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

Leave a comment:

Your comment will only be published after it has been moderated and found spam free.
Your e-mail address will only be used to display your Gravatar.