|
Make command buttons on Access forms come alive by changing colors as a user hovers over a button or clicks it. Sample database has a form to pick and copy colors and shape to make it quick and convenient to change things. Properties are better organized than on the Property Sheet (which doesn't even have Shape), and you see the effect right away. Color numbers are also displayed as Red, Green, Blue so you can better visualize what a color number looks like.
Thanks to Daniel Pineault VBA – ChooseColor API x32 & x64 and Mike Wolfe, Open the Windows Color Dialog from VBA for posting code to use the built-in color chooser and explaoning it. In the VBA listing below, the first function is DialogColor, using the ChooseColor API to popup a dialog box to choose color.
Click on a colored box to popup the built-in color picker. Once a color is chosen in the dialog box, Access shows the color on the form, displays the color number, and determines and fills in the RGB values.
Instead of using the color chooser dialog, you can directly change the color number or RGB values. As you make changes, the sample Color Me command button changes, and you can test to see if you like that color with the rest. Also change Font Size and Shape.
Click any command button on the form to write its property values to the Debug window so you can easily copy them to use somewhere else.
The properties that control color and shape for command buttons are:
Property | Data Type | Description |
---|---|---|
UseTheme | Boolean | True to recognize named theme properties and for more control over appearance. |
ForeColor | Long Integer | Text color |
BackColor | Long Integer | Background/Fill color |
BorderColor | Long Integer | Border/outline color |
HoverForeColor | Long Integer | Text color when user hovers over command button |
HoverColor | Long Integer | Background/Fill color when user hovers over command button |
PressedForeColor | Long Integer | Text color when user clicks the command button |
PressedColor | Long Integer | Background/Fill color when user clicks the command button |
Shape | Long Integer | Value from 0 to 7. Default=1, Rounded Rectangle. |
UseTheme turns on the ability to use named Theme Colors, which are the default colors. If you use standard colors, it doesn't matter if UseTheme is true or false. However, if UseTheme is false, the BackColor of a command button has to be gray, and you can't change the Shape. If you change certain properties that are affected by themes, Access will automatically set UseTheme to true.
In design view, to change command button colors, use the property sheet or ribbon. To change command button shape, use the Format ribbon.
Download sample database with a form to pick and copy colors and shape,
VBA code,
and a table for shapes.
updated 3 June
CommandButtons_ColorPicker_s4p_ACCDB.zip
Remember to UNBLOCK files you download to remove the Mark of the Web. Here are steps to do that: https://msaccessgurus.com/MOTW_Unblock.htm
The
DialogColor function
uses the ChooseColor API.
It was originally written by Daniel Pineault,
modified by Mike Wolfe,
and then by me.
' bas_DialogColor_Daniel_Mike 'code from NoLongerSet by Mike Wolfe ' https://nolongerset.com/color-dialog/ 'references DevHut by Daniel Pineault ' https://www.devhut.net/vba-choosecolor-api-x32-x64/ '----------------------------------------------------------------------- '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 modified s4p 5/30/23 set custom colors ' 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 ' custom colors is an optional array not ParamArray. ' ---------------------------------------------------------------- Public Function DialogColor(DefaultColor As Long _ ,Optional CustomColors As Variant) As Long 'Populate array of custom colors Dim Colors(16) As Long,i As Long If Not IsMissing(CustomColors) Then 'crystal For i = LBound(CustomColors) To UBound(CustomColors) Colors(i) = CustomColors(i) Next i End If 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
function to GetRGBstring from a color number
Public Function GetRGBstring(pnColr As Long) As String ' strive4peace ' get RGB values from color number ' return as comma-delimited string Dim R As Integer Dim G As Integer Dim B As Integer R = (pnColr Mod 65536) Mod 256 G = (pnColr Mod 65536) \ 256 B = pnColr \ 65536 GetRGBstring = R & ", " & G & ", " & B End Function
'cbf: f_MENU_CommandButton_Color_Shape '*************** Code Start *********************************************** ' Purpose : Make command button come alive ' by assigning colors to properties ' Author : crystal (strive4peace) ' Code List: https://msaccessgurus.com/code.htm ' This code: https://msaccessgurus.com/VBA/CommandButton_ColorPicker.htm ' LICENSE : ' You may freely use and share this code, but not sell it. ' Keep attribution. Mark your changes. Use at your own risk. '------------------------------------------------------------------------------- ' module variable '------------------------------------------------------------------------------- Private maColorPropertyName() As String '------------------------------------------------------------------------------- ' Form_Load '------------------------------------------------------------------------------- Private Sub Form_Load() '230529 s4p, 230531 maColorPropertyName = Split( _ "ForeColor" _ & ";BackColor" _ & ";BorderColor" _ & ";HoverForeColor" _ & ";HoverColor" _ & ";PressedForeColor" _ & ";PressedColor" _ , ";") Dim sColrControlname As String _ ,sBoxControlname As String _ ,sRgbControlname As String _ ,nColr As Long _ ,i As Integer _ ,vPropertyName As Variant 'populate colors With Me For Each vPropertyName In maColorPropertyName sColrControlname = "colr_" & vPropertyName sBoxControlname = "Box_" & vPropertyName sRgbControlname = "rgb_" & vPropertyName 'read color value from example command button nColr = .cmd_ColorMe.Properties(vPropertyName) 'show color or value .Controls(sColrControlname).Value = nColr .Controls(sBoxControlname).BackColor = nColr .Controls(sRgbControlname).Value = GetRGBstring(nColr) Next vPropertyName 'read Shape and FontSize With .cmd_ColorMe Me.lst_Shape = .Shape Me.txt_FontSize = .FontSize End With End With End Sub '------------------------------------------------------------------------------- ' COLOR '------------------------------------------------------------------------------- '------------------------------------------ Change Color Number Private Sub colr_ForeColor_AfterUpdate() '230531 Call SetColor( "ForeColor" _ ,Nz(Me.ActiveControl.Value,-99) _ , "colr") End Sub Private Sub colr_BackColor_AfterUpdate() Call SetColor( "BackColor" _ ,Nz(Me.ActiveControl.Value,-99) _ , "colr") End Sub Private Sub colr_BorderColor_AfterUpdate() Call SetColor( "BorderColor" _ ,Nz(Me.ActiveControl.Value,-99) _ , "colr") End Sub Private Sub colr_HoverForeColor_AfterUpdate() Call SetColor( "HoverForeColor" _ ,Nz(Me.ActiveControl.Value,-99) _ , "colr") End Sub Private Sub colr_HoverColor_AfterUpdate() Call SetColor( "HoverColor" _ ,Nz(Me.ActiveControl.Value,-99) _ , "colr") End Sub Private Sub colr_PressedForeColor_AfterUpdate() Call SetColor( "PressedForeColor" _ ,Nz(Me.ActiveControl.Value,-99) _ , "colr") End Sub Private Sub colr_PressedColor_AfterUpdate() Call SetColor( "PressedColor" _ ,Nz(Me.ActiveControl.Value,-99) _ , "colr") End Sub '------------------------------------------ Change RGB Private Sub rgb_ForeColor_AfterUpdate() '230531 Call ChangeRGB( "ForeColor") End Sub Private Sub rgb_BackColor_AfterUpdate() Call ChangeRGB( "BackColor") End Sub Private Sub rgb_BorderColor_AfterUpdate() Call ChangeRGB( "BorderColor") End Sub Private Sub rgb_HoverForeColor_AfterUpdate() Call ChangeRGB( "HoverForeColor") End Sub Private Sub rgb_HoverColor_AfterUpdate() Call ChangeRGB( "HoverColor") End Sub Private Sub rgb_PressedForeColor_AfterUpdate() Call ChangeRGB( "PressedForeColor") End Sub Private Sub rgb_PressedColor_AfterUpdate() Call ChangeRGB( "PressedColor") End Sub '------------------------------------------------------------------------------- ' ChangeRGB '------------------------------------------------------------------------------- Private Sub ChangeRGB(psProperty As String) '230531 Dim sValue As String _ ,nColr As Long Dim aRGB() As String sValue = Nz(Me.ActiveControl.Value, "") aRGB = Split(sValue, ",") If UBound(aRGB) - LBound(aRGB) <> 2 Then Exit Sub End If 'assume the values are valid numbers nColr = RGB(aRGB(0),aRGB(1),aRGB(2)) Call SetColor(psProperty _ ,nColr _ , "rgb") End Sub '------------------------------------------------------------------------------- ' SetColor '------------------------------------------------------------------------------- Private Sub SetColor(psPropertyName As String _ ,pnColr As Long _ ,Optional pSkip As String _ ) Dim sColrControlname As String _ ,sBoxControlname As String _ ,sRgbControlname As String If pnColr < 0 Then Exit Sub With Me sColrControlname = "colr_" & psPropertyName sBoxControlname = "Box_" & psPropertyName sRgbControlname = "rgb_" & psPropertyName 'show color or value If Not InStr(pSkip, "colr") >= 1 Then .Controls(sColrControlname).Value = pnColr End If If Not InStr(pSkip, "Box") >= 1 Then .Controls(sBoxControlname).BackColor = pnColr End If If Not InStr(pSkip, "rgb") >= 1 Then .Controls(sRgbControlname).Value = GetRGBstring(pnColr) End If End With 'me 'Change property for command button Me.cmd_ColorMe.Properties(psPropertyName) = pnColr End Sub '------------------------------------------ Box color picker Private Sub Box_ForeColor_Click() Call PickMyColor( "ForeColor") End Sub Private Sub Box_BackColor_Click() Call PickMyColor( "BackColor") End Sub Private Sub Box_BorderColor_Click() Call PickMyColor( "BorderColor") End Sub Private Sub Box_HoverForeColor_Click() Call PickMyColor( "HoverForeColor") End Sub Private Sub Box_HoverColor_Click() Call PickMyColor( "HoverColor") End Sub Private Sub Box_PressedForeColor_Click() Call PickMyColor( "PressedForeColor") End Sub Private Sub Box_PressedColor_Click() Call PickMyColor( "PressedColor") End Sub '------------------------------------------------------------------------------- ' PickMyColor '------------------------------------------------------------------------------- Private Sub PickMyColor(sPropertyName As String _ ,Optional pnColr As Long = -99) '230529 use Access built-in color picker 'CALLS ' DialogColor 'code from NoLongerSet by Mike Wolfe ' https://nolongerset.com/color-dialog/ 'references DevHut by Daniel Pineault ' https://www.devhut.net/vba-choosecolor-api-x32-x64/ ' SetColorArray -- define custom colors ' SetColor ' set appropriate color for example control ' and data for user to copy or make a note of 'PARAMETERS ' sPropertyName is the name of the property to change for example ' pnColr is negative to read box BackColor ' or positive to set to something specific Dim nColr As Long _ ,nColrPick As Long 'must be Variant instead of Long for passing Static aColor(0 To 15) As Variant If aColor(0) = 0 Then 'only do this if colors aren't defined Call SetColorArray(aColor) 'you could call a different procedure 'to load different custom values End If If pnColr < 0 Then 'read BackColor from box (default) nColr = Me( "Box_" & sPropertyName).BackColor End If 'call ChooseColor API ' via DialogColor by Daniel Pineault modified by Mike Wolfe ' send array (not ParamArray) for custom colors - modified by crystal nColrPick = DialogColor(nColr,aColor) 'chosen color is different If nColrPick <> nColr Then Call SetColor(sPropertyName,nColrPick) End If End Sub '------------------------------------------ click Command Button Private Sub cmd_DefaultButton_Click() Call ShowMyColors End Sub Private Sub cmd_NoTheme_Click() Call ShowMyColors End Sub Private Sub cmd_Command_Click() Call ShowMyColors End Sub Private Sub cmd_Tab_Click() Call ShowMyColors End Sub Private Sub cmd_Round_Click() Call ShowMyColors End Sub Private Sub cmd_ColorMe_Click() Call ShowMyColors End Sub '------------------------------------------------------------------------------- ' ShowMyColors '------------------------------------------------------------------------------- Private Sub ShowMyColors() '230528 s4p, 230531, 601, 603 Dim sMsg As String _ ,sControlName As String _ ,sText As String _ ,vPropertyName As Variant _ ,vValue As Variant With Me.ActiveControl sControlName = .Name Debug.Print "*** " & sControlName Debug.Print "UseTheme"; Tab(20); .UseTheme sMsg = "UseTheme: " & .UseTheme & vbCrLf sText = "" ' these are just property names for color For Each vPropertyName In maColorPropertyName vValue = .Properties(vPropertyName) sText = " (" & GetRGBstring(CLng(vValue)) & ")" Debug.Print vPropertyName; Debug.Print Tab(20); Debug.Print vValue; Debug.Print Tab(32); Debug.Print sText sMsg = sMsg & vPropertyName & ": " _ & .Properties(vPropertyName) _ & sText _ & vbCrLf Next vPropertyName 'add FontSize Debug.Print "FontSize"; Tab(20); .FontSize sMsg = sMsg & "FontSize: " & .FontSize _ & vbCrLf 'add Shape Debug.Print "Shape"; Tab(20); .Shape sMsg = sMsg & "Shape: " & .Shape & " " _ & DLookup( "ShapeName", "enum_Shape", "Shapei=" & .Shape) _ & vbCrLf 'finalize message sMsg = sMsg & vbCrLf & "Ctrl-G to copy from Debug window" End With MsgBox sMsg,, "Properties for " & sControlName End Sub '------------------------------------------------------------------------------- ' SetColorArray '------------------------------------------------------------------------------- Private Sub SetColorArray(aColor As Variant) 'fill array of color values 'colors from Daniel aColor(0) = RGB(255,255,255) 'White aColor(1) = RGB(0,0,0) 'Black aColor(2) = RGB(255,0,0) 'Red aColor(3) = RGB(0,255,0) 'Green aColor(4) = RGB(0,0,255) 'Blue 'colors added by crystal (strive4peace) aColor(5) = RGB(255,255,0) 'bright yellow aColor(6) = RGB(255,152,0) 'orange aColor(7) = RGB(153,0,255) 'purple aColor(8) = RGB(112,173,71) 'tree Green aColor(9) = RGB(33,150,243) 'Blue medium aColor(10) = RGB(150,100,0) 'brown aColor(11) = RGB(255,244,202) 'pale yellow aColor(12) = RGB(225,168,168) 'rose aColor(13) = RGB(251,218,181) 'tan aColor(14) = RGB(214,226,188) 'sea green aColor(15) = RGB(192,80,77) 'brick red End Sub '------------------------------------------------------------------------------- ' Shape '------------------------------------------------------------------------------- Private Sub lst_Shape_MouseUp(Button As Integer,Shift As Integer,X As Single,Y As Single) '230529 s4p written generically -- drop always With Me.ActiveControl ' If IsNull(.Value) Then .Dropdown ' End If End With 'me End Sub Private Sub lst_Shape_AfterUpdate() '230531 s4p With Me.lst_Shape If Not IsNull(.Value) Then Me.cmd_ColorMe.Shape = CLng(.Value) End If End With End Sub '------------------------------------------------------------------------------- ' FontSize '------------------------------------------------------------------------------- Private Sub txt_FontSize_AfterUpdate() '230531 s4p With Me.txt_FontSize If Not IsNull(.Value) Then Me.cmd_ColorMe.FontSize = .Value End If End With End Sub '*************** Code End *****************************************************
VBA – ChooseColor API x32 & x64, by Daniel Pineault on DevHut
https://www.devhut.net/vba-choosecolor-api-x32-x64/
Open the Windows Color Dialog from VBA, by Mike Wolfe on NoLongerSet
https://nolongerset.com/color-dialog/
Colour Converter & Selector, by Colin Riddington (isladogs)
https://www.isladogs.co.uk/colour-converter
Help: CommandButton.UseTheme property
Help: CommandButton.ForeColor property
Help: CommandButton.BackColor property
Help: CommandButton.BorderColor property
Help: CommandButton.HoverForeColor property
Help: CommandButton.HoverColor property
Help: CommandButton.PressedForeColor property
Help: CommandButton.PressedColor property
Help: CommandButton.Shape property
Help is wrong for Command button Shapes.
Maximum = 7 and it is Oval,
not Round Same Side Corner Rectangle.
Help: CommandButton.BackStyle property
Help: CommandButton.BorderStyle property
Help: CommandButton.FontName property
Help: CommandButton.FontSize property
When users move around on a form in Access, it's nicer when colors change so the form communicates better and shows them where they are and what they click on. This was just going to be a quick way to set colors for a command button so it can be more responsive but then it got really interesting when I decided to try the built-in color chooser API.
While the color palette isn't impressive, you can set up to 16 custom colors*. More wonderful is the ability to set RGB values and a slider to quickly make a color lighter or darker — and visually see the resulting color as you make changes.
It's interesting how things evolve ...
Daniel Pineault first wrote the DialogColor function that calls the ChooseColor API. Then Mike Wolfe modified it. After I posted this page, Colin Riddington sent a link to his Colour Converter & Selector, which uses the same API (he's a Brit so he spells Color wrong, lol). Links to these resources are under Reference on this page.
*On setting custom colors: Daniel originally set 5 of them directly in the DialogColor code. (The ones not set are black). Mike added flexibility by passing a ParamArray to specify the custom colors and made other nice changes.
I then changed ParamArray for custom colors to be a regular array. Even though colors are Long Integer, if the array is dimensioned As Variant, it can be passed as a variant.
The SetColorArray sub also takes advantage of passing an array. In this example, it's Private, but it could be Public — and different procedures could be called depending on something else.
Here's the link for this page in case you want to copy it and share it with someone:
https://msaccessgurus.com/VBA/CommandButton_ColorPicker.htm
or in old browsers:
http://www.msaccessgurus.com/VBA/CommandButton_ColorPicker.htm
Let's connect and team-develop your application together. You have the business knowledge; I know how to design and automate Access, and am a teacher. I show you how to do it yourself. My goal is to empower you as I believe you should hold the reins on your important information.
While we build something great together, I'll pull in code and features from my vast libraries as needed, cutting out lots of development time. And you'll get links to great resources.
Do you want your Access application to be more responsive?
Let's connect, I can show you how to make it better.
Email me at training@msAccessGurus
~ crystal
the simplest way is best, but usually the hardest to see