Embedded Files
Add a Little Class to Excel's UserForms
This post shows how to, with a little class and very little coding, add color and dynamic effects to forms. This also offers new coders an opportunity to learn about class modules used for handling userform events.
Background
Excel’s user forms lack class (pun intended). By default they are dull and dead. They don’t have to be.
With a small class module, any Excel user form can be "classy". They can reflect your company’s branding. They can even add a little life by lighting up buttons as the mouse moves over, just like Excel’s ribbon controls.
Demo
Seeing is believing. So here is a short video demonstrating how clsForm transforms userforms and how easy it is to make your forms "classy".
NOTE! The video is a bit old. The links below point to a newer version of clsForm along with new documentation. The new version makes adding class to forms even easier.
So kick back. Watch the short video, then download the PDF using the links below. Like all BXL projects, everything is free. If you find this helpful, please like the video, post a comment, or perhaps a note on BXL's Facebook page. And as always, keep XL'n!
Implementing
We can implement clsForm from within a userform with just two lines of code, or attach clsForm to a userform from a module. I prefer adding the class in a userform's initialize event so when the form displays, the class activates simultaneously.
Example:
One way to implement this class on a userform takes two lines of code placed in the UserForm_Initialize procedure. Here is a sample:
Private Sub UserForm_Initialize()
' NOTE! Static - to keep in memory after this routine ends
Static FormClass As New clsForm
Set FormClass.UserForm = Me
End Sub
To create this we must first insert a class module (Insert > Class Module). Name it clsForm. Next copy all of these code segments to the class module.
Class Module Level Code
This first section creates variables that will be accessible by all routines in this class.
' Version: 12/10/19
' Save As: clsForm
' Description:Formats User Forms and Controls
' Date Ini Modification
' 06/21/13 CWH Initial Programming
' 07/10/14 CWH Version 2014.07
' 10/22/14 CWH Changed sRoutine to cRoutine
' 04/05/17 CWH Added flexibility in coloring
Option Explicit
' Private Properties
Const cModule As String = "clsForm" 'This module's name
Const Success As Boolean = False 'Successful Finish
Const Failure As Boolean = True 'Failed Finish
Const NoError As Long = 0 'No Error
Const LogError As Long = 997 'Log Error
Const RtnError As Long = 998 'Return Error
Const DspError As Long = 999 'Display Error
Private WithEvents oMsForm As UserForm 'Object for Form Events
Private WithEvents oFrame As Frame 'Object for Frame Events
Private WithEvents oCmdBtn As CommandButton 'Object for Command Button Events
Private WithEvents oTglBtn As ToggleButton 'Object for Toggle Button Events
Private WithEvents oImage As Image 'Object for Image Control Events
Private WithEvents oMltPag As Multipage 'Object for Multipage Events
Private oForm As Object 'Object for Form Properties
Dim dicCtrls As Object 'Controls that impact Glowing
Class Public Property
When the form is assigned to this class object, this class object finds all controls on the form and creates new instances of this class for each control
Public Property Set UserForm(ByVal oUserForm As Object)
' Description:Attach Userform to Class
' Inputs: oUserForm User form
' Outputs: *None
' Requisites: Routines Setup
' Example: *None
' Note! Object type "UserForm" does not expose all form properties.
' Examples include: Top, Left, Width, Height, and Caption.
' A generic object will. But a generic object does not expose
' any events. So to expose events AND all properties
' we pass the user form as a generic "Object" (for properties)
' and assign it to an MsForms.UserForm object (for events).
' Date Ini Modification
' 06/21/13 CWH Initial Programming
' Declarations
Const cRoutine As String = "UserForm"
' Error Handling Initialization
On Error GoTo ErrHandler
' Initialize Variables
If dicCtrls Is Nothing Then _
Set dicCtrls = CreateObject("Scripting.Dictionary")
' Procedure
Set oForm = oUserForm: Set oMsForm = oForm
Setup oForm
ErrHandler:
Select Case Err.Number
Case Is = NoError: 'Do nothing
Case Else:
Select Case DspErrMsg(cModule & "." & cRoutine)
Case Is = vbAbort: Stop: Resume 'Debug mode - Trace
Case Is = vbRetry: Resume 'Try again
Case Is = vbIgnore: 'End routine
End Select
End Select
End Function
Control Properties
When the form is assigned to this class object, this class object finds all controls on the form and creates new instances of this class for each control
Public Property Set Frame(ByVal Frame As Frame)
Set oFrame = Frame
End Property
Public Property Set Multipage(ByVal Multipage As Multipage)
Set oMltPag = Multipage
End Property
Public Property Set CommandButton(ByVal CommandButton As CommandButton)
Set oCmdBtn = CommandButton
End Property
Public Property Set ToggleButton(ByVal ToggleButton As ToggleButton)
Set oTglBtn = ToggleButton
End Property
Public Property Set Image(ByVal Image As Image)
Set oImage = Image
End Property
Event Handlers
These routines respond to MouseMoves over each object.
Remove glow effects from all controls on form when mouse is over the form and not any of the controls.
Private Sub oMsForm_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
' Description:Sets all Command Buttons to "normal" color
' Inputs: Button Pressed Mouse button
' Shift State of the SHIFT, CTRL, and ALT keys
' X Mouse X
' Y Mouse Y
' Outputs: Me Success/Failure
' Requisites: *None
' Notes: http://msdn.microsoft.com/en-us/library/office/aa220909(v=office.11).aspx
' Example: *None (Event Handler)
' Date Ini Modification
' 06/21/13 CWH Initial Programming
' Declarations
Const cRoutine As String = "oMsForm_MouseMove"
Dim oCtrl As control
' Error Handling Initialization
On Error GoTo ErrHandler
' Procedure
For Each oCtrl In oForm.Controls
If TypeName(oCtrl) = "CommandButton" Then
oCtrl.BackColor = Color(crButton)
oCtrl.ForeColor = Color(crButtonFont)
End If
If TypeName(oCtrl) = "Image" Then
oCtrl.BackColor = Color(crButton)
oCtrl.BackStyle = fmBackStyleTransparent
End If
Next
ErrHandler:
Select Case Err.Number
Case Is = NoError: 'Do nothing
Case Else:
Select Case DspErrMsg(cModule & "." & cRoutine)
Case Is = vbAbort: Stop: Resume 'Debug mode - Trace
Case Is = vbRetry: Resume 'Try again
Case Is = vbIgnore: 'End routine
End Select
End Select
End Function
Remove glow effects from all controls in frame when mouse is over the frame and not any of the controls.
Private Sub oFrame_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
' Description:Sets all Command Buttons to "normal" color
' Inputs: Button Pressed Mouse button
' Shift State of the SHIFT, CTRL, and ALT keys
' X Mouse X
' Y Mouse Y
' Outputs: Me Success/Failure
' Requisites: *None
' Example: *None (Event Handler)
' Date Ini Modification
' 06/09/14 CWH Initial Programming
' Declarations
Const cRoutine As String = "oFrame_MouseMove"
Dim oCtrl As control
' Error Handling Initialization
On Error GoTo ErrHandler
' Procedure
For Each oCtrl In oFrame.Controls
If TypeName(oCtrl) = "CommandButton" Then
oCtrl.BackColor = Color(crButton)
oCtrl.ForeColor = Color(crButtonFont)
End If
If TypeName(oCtrl) = "Image" Then
oCtrl.BackColor = Color(crButton)
oCtrl.BackStyle = fmBackStyleTransparent
End If
Next
ErrHandler:
Select Case Err.Number
Case Is = NoError: 'Do nothing
Case Else:
Select Case DspErrMsg(cModule & "." & cRoutine)
Case Is = vbAbort: Stop: Resume 'Debug mode - Trace
Case Is = vbRetry: Resume 'Try again
Case Is = vbIgnore: 'End routine
End Select
End Select
End Function
Make command buttons glow when the mouse is over them.
Private Sub oCmdBtn_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
oCmdBtn.BackColor = Color(crButtonGlow)
oCmdBtn.ForeColor = Color(crButtonGlowFont)
End Sub
Make toggle buttons glow when the mouse is over them.
Private Sub oTglBtn_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
oTglBtn.BackColor = Color(crButtonGlow)
oTglBtn.ForeColor = Color(crButtonGlowFont)
End Sub
Make Image controls glow when the mouse is over them.
Private Sub oImage_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
oImage.BackColor = Color(crButtonGlow)
oImage.BackStyle = fmBackStyleOpaque
End Sub
Remove glow effects from all controls in the multipage when mouse is over the multipage and not any of the controls.
Private Sub oMltPag_MouseMove(ByVal Index As Long, _
ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
' Description:Sets all Command Buttons to "normal" color
' Inputs: Button Pressed Mouse button
' Shift State of the SHIFT, CTRL, and ALT keys
' X Mouse X
' Y Mouse Y
' Outputs: Me Success/Failure
' Requisites: *None
' Notes: http://msdn.microsoft.com/en-us/library/office/aa220909(v=office.11).aspx
' Example: *None (Event Handler)
' Date Ini Modification
' 06/21/13 CWH Initial Programming
' Declarations
Const cRoutine As String = "oMltPag_MouseMove"
Dim oCtrl As control
' Error Handling Initialization
On Error GoTo ErrHandler
' Procedure
For Each oCtrl In oMltPag.Parent.Controls
If TypeName(oCtrl) = "CommandButton" Then
oCtrl.BackColor = Color(crButton)
oCtrl.ForeColor = Color(crButtonFont)
End If
Next
ErrHandler:
Select Case Err.Number
Case Is = NoError: 'Do nothing
Case Else:
Select Case DspErrMsg(cModule & "." & cRoutine)
Case Is = vbAbort: Stop: Resume 'Debug mode - Trace
Case Is = vbRetry: Resume 'Try again
Case Is = vbIgnore: 'End routine
End Select
End Select
End Sub
Private Routines
This function is called when the UserForm property is set.
Private Function Setup(ByVal oForm As Object) As Boolean
' Description:Set backgrounds, fonts, and position
' Inputs: oForm User Form (as Object for Properties)
' Outputs: Me Success/Failure
' Requisites: Classes clsForm
' Example: ?Setup(oForm)
' Date Ini Modification
' 06/21/13 CWH Initial Development
' 04/05/17 CWH Allow crFrom to be a picture
' Declarations
Const cRoutine As String = "Setup"
Dim oCtrl As control
Dim oPage As control
Dim clsCtrl As clsForm
' Error Handling Initialization
On Error GoTo ErrHandler
' Procedure
ApyClr oForm, crForm
For Each oCtrl In oForm.Controls
Set clsCtrl = New clsForm
With oCtrl
Select Case TypeName(oCtrl)
Case Is = "TextBox"
If .Name = "txtErrMsg" Then
.BackStyle = fmBackStyleTransparent
.ForeColor = Color(crFormFont)
Else
ApyClr oCtrl, crLight
End If
Case Is = "ComboBox", "ListBox"
ApyClr oCtrl, crLight
Case Is = "CommandButton"
Set clsCtrl.CommandButton = oCtrl
Set dicCtrls(oCtrl.Name) = clsCtrl
ApyClr oCtrl, crButton
Case Is = "Image"
Set clsCtrl.Image = oCtrl
Set dicCtrls(oCtrl.Name) = clsCtrl
.BackColor = Color(crButton)
Case Is = "Frame"
Set clsCtrl.Frame = oCtrl
Set dicCtrls(oCtrl.Name) = clsCtrl
ApyClr oCtrl, crFrame
Case Is = "TabStrip"
.BackColor = Color(crForm)
.ForeColor = Color(crDark)
Case Is = "MultiPage"
Set clsCtrl.Multipage = oCtrl
Set dicCtrls(oCtrl.Name) = clsCtrl
ApyClr oCtrl, crForm
For Each oPage In .Pages
ApyClr oCtrl, crForm
Next
Case Is = "SpinButton", "ScrollBar"
ApyClr oCtrl, crButton
Case Is = "Label", "CheckBox", _
"OptionButton", "ToggleBotton"
ApyClr oCtrl, crForm
End Select
End With
Set clsCtrl = Nothing
Next
oForm.StartUpPosition = 3 'Windows Default
With Application
oForm.Left = .Left + .Width / 2 - oForm.Width / 2
oForm.Top = .Top + .Height / 2 - oForm.Height / 2
End With
ErrHandler:
Select Case Err.Number
Case Is = NoError: 'Do nothing
Case Else:
Select Case DspErrMsg(cModule & "." & cRoutine)
Case Is = vbAbort: Stop: Resume 'Debug mode - Trace
Case Is = vbRetry: Resume 'Try again
Case Is = vbIgnore: 'End routine
End Select
End Select
End Function
This is called by Setup()
Private Function ApyClr(ByVal oControl As Object, _
ByVal lColor As crRequestTypes) As Boolean
' Description:Apply color or picture to Control
' Inputs: oControl Control to set
' lColor Color Request
' Outputs: Me Success/Failure
' Requisites: Routines modGeneral.Color
' Example: ApyClr oForm, crForm
' Date Ini Modification
' 04/06/17 CWH Initial Development
' Declarations
Const cRoutine As String = "ApyClr"
' Error Handling Initialization
On Error GoTo ErrHandler
ApyClr = Failure
' Procedure
With oControl
.ForeColor = Color(lColor + 1)
If TypeName(Color(lColor)) = "Picture" Then
.Picture = Color(lColor)
.PictureAlignment = 2 'fmPictureAlignmentCenter
.PictureSizeMode = 0
.PictureTiling = True
Else
.BackColor = Color(lColor)
End If
If InStr(1, TypeName(oForm) & ",Image", TypeName(oControl)) > 0 Then
If TypeName(Color(crSkin)) = "Picture" Then
.Picture = Color(crSkin)
.PictureAlignment = 2 'fmPictureAlignmentCenter
.PictureSizeMode = 0
.PictureTiling = True
End If
End If
End With
ApyClr = Success
ErrHandler:
Select Case Err.Number
Case Is = NoError: 'Do nothing
Case Else:
Select Case DspErrMsg(cModule & "." & cRoutine)
Case Is = vbAbort: Stop: Resume 'Debug mode - Trace
Case Is = vbRetry: Resume 'Try again
Case Is = vbIgnore: 'End routine
End Select
End Select
End Function
Page updated
Google Sites
Report abuse