Open the Windows Color Dialog from VBA

The other day I was working on a project where I needed to prompt the user to provide a custom background color for a form.  I wanted to use the built-in Windows color picker control.  You know the one:

At first I headed for Google, but there can be a lot of noise in Google web search results.  So, instead, I went to Daniel Pineault's site, devhut.net, and searched for "color picker."  I was not disappointed:

Minor Modifications

Daniel's DialogColor function did almost exactly what I needed.  I just made a few tweaks to customize it to my situation, including:

• The modified function requires that you pass a default color
• You can pass up to 16 custom colors as optional parameters
• Default color returned if user cancels

Default Color is a Required Parameter

My modified function requires that you pass a default color.   The default color is an optional parameter in Daniel's original code.  Passing a value of 0 for the default color sets the default to black, which has the same effect of not passing a default at all in Daniel's original code.

Custom Colors May be Passed as an Optional ParamArray

By making the DefaultColor a required parameter, I was able to use a ParamArray to accept up to 16 prefilled custom colors.  One of the rules with procedures in my Code Library is that they cannot be application-specific.  I must be able to replace one version of a code library module with a newer version without requiring any tweaks.  

Daniel's version lets you set up custom colors, too, but the colors are hard-coded into the function.  You would need a new function for each different set of custom colors you wanted to support.

Default Color Returned if User Cancels

In the original function, Daniel returns the color white if the user cancels out of the color picker dialog.  Since I made the default color a required parameter, I thought it made more sense to return that instead.

The Modified Code: DialogColor()

Below is my modified version of Daniel's original function, complete with backlinks to Daniel's site in the code comments.

'-----------------------------------------------------------------------
'Declarations for DialogColor function

Private Const CC_ANYCOLOR = &H100
'Private Const CC_ENABLEHOOK = &H10
'Private Const CC_ENABLETEMPLATE = &H20
'Private Const CC_ENABLETEMPLATEHANDLE = &H40
Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Const CC_RGBINIT = &H1
'Private Const CC_SHOWHELP = &H8
'Private Const CC_SOLIDCOLOR = &H80

#If VBA7 Then
    Private Type ChooseColor
        lStructSize               As Long
        hwndOwner                 As LongPtr
        hInstance                 As LongPtr
        rgbResult                 As Long
        lpCustColors              As LongPtr
        Flags                     As Long
        lCustData                 As LongPtr
        lpfnHook                  As LongPtr
        lpTemplateName            As String
    End Type
    Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
#Else
    Private Type ChooseColor
        lStructSize               As Long
        hwndOwner                 As Long
        hInstance                 As Long
        rgbResult                 As Long
        lpCustColors              As Long
        Flags                     As Long
        lCustData                 As Long
        lpfnHook                  As Long
        lpTemplateName            As String
    End Type
    Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
#End If
'=======================================================================


' ----------------------------------------------------------------
' Procedure : DialogColor
' Author    : Daniel Pineault
' Source    : https://www.devhut.net/vba-choosecolor-api-x32-x64/
' Adapted by: Mike Wolfe
' Date      : 2/2/2023
' Purpose   : Display the Windows color chooser dialog.
' Notes     - Returns the default color if the user cancels.
'           - Pass 0 as the DefaultColor to use the Color Picker default of black.
'           - DefaultColor is required so that custom colors can be
'               passed via optional ParamArray.
'           - Custom colors should be passed as long integers.
' Sample Usage:
'   UserColorChoice = DialogColor(0, RGB(240, 240, 240), vbRed, vbGreen, vbBlue)
' ----------------------------------------------------------------
Public Function DialogColor(DefaultColor As Long, ParamArray CustomColors() As Variant) As Long
    'Populate array of custom colors
    Dim Colors(16) As Long, i As Long
    For i = LBound(CustomColors) To UBound(CustomColors)
        Colors(i) = CustomColors(i)
    Next i

    Dim CC As ChooseColor
    With CC
        .lStructSize = LenB(CC)
        .hwndOwner = Application.hWndAccessApp
        .Flags = CC_ANYCOLOR Or CC_FULLOPEN Or CC_PREVENTFULLOPEN Or CC_RGBINIT
        .rgbResult = DefaultColor    'Set the initial color of the dialog
        .lpCustColors = VarPtr(Colors(0))
    End With
    
    Dim ReturnCode As Long
    ReturnCode = ChooseColor(CC)
    If ReturnCode = 0 Then
        'Cancelled by the user
        DialogColor = DefaultColor
    Else
        DialogColor = CC.rgbResult
    End If
End Function