Open the Windows Color Dialog from VBA
If you need to get Access color values from your users, this is the easiest way to do it.
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