LockControls() Function: Locking and Unlocking Multiple MS Access Controls in VBA
Oftentimes when designing a form you want to be able to lock or unlock a group of controls.
There are several possible reasons to want to do this:
- To prevent certain users from making changes
- To prevent changes to a record once it's been "finalized"
- To prevent changes based on the value of another field on the record
- Etc.
One common way to do this is by using the Tag property of the controls. However, that requires context switching between the code editor and the form designer. It also makes it less obvious which controls are affected.
The most common technique in code is to go set the Locked property for each affected control one at a time. This gets cumbersome, especially if you want to set related properties (such as Enabled) at the same time.
To simplify this type of situation, I wrote a function that takes a variable number of controls by taking advantage of the ParamArray feature in VBA.
The Approach
This function is used to lock or unlock an arbitrary number of form controls.
It takes a boolean parameter Locked
that specifies whether the controls should be locked or unlocked. The function accepts an arbitrary number of control parameters as a ParamArray
.
The function loops through each control, checks its ControlType and sets the appropriate properties based on the "Locked" parameter.
Label controls are hidden if they are included in the control array, while Checkbox labels are set to gray when their associated checkbox is locked and black when unlocked. All other control types get grayed out when they are locked.
Locked controls also get disabled with the exception of combo boxes, as that allows users to still drop down the combo and see the other options that are not selected.
A Brief Note About the On Error Resume Next
The use of On Error Resume Next
is poor programming practice, but it's been in place in this function for nearly 14 years. A better approach would be to handle expected errors and reraise unexpected ones. I don't know what the expected and unexpected errors are at this point. I do know that the function has served me well in its current state.
That said, I would not recommend using the function to protect the controls to a nuclear reactor from a hostile actor. Its intended purpose is to help well-meaning users avoid accidentally changing data they shouldn't. It should be fine for that use.
The Algorithm
- Loop through every control passed in the ParamArray
- Disable each control type to the fullest extent possible, providing visual cues to help the user understand that a control has been locked and can't be changed
The Function
Here is the LockControls()
function on its own without its required dependencies.
' ----------------------------------------------------------------
' Procedure : LockControls
' Date : 5/26/2009
' Author : Mike Wolfe
' Source : https://nolongerset.com/lockcontrols/
' Purpose : Locks or unlocks an arbitrary number of form controls.
' Notes - Label controls can be included in the control array
' and will be hidden in the "Locked" state.
' - Checkbox labels will be set to gray when their associated
' checkbox is locked and black when unlocked.
' ----------------------------------------------------------------
Sub LockControls(Locked As Boolean, ParamArray ctlControls() As Variant) 'vv
On Error Resume Next
Dim CtlArrayVar As Variant
For Each CtlArrayVar In ctlControls
Dim Ctl As Control
Set Ctl = CtlArrayVar
With Ctl
If Ctl.ControlType = acLabel Then
'Hide labels that are 'locked'
Ctl.Visible = Not Locked
Else
If Locked Then
If Ctl.ControlType <> acCommandButton And _
Ctl.ControlType <> acToggleButton Then .Locked = True
If Ctl.ControlType <> acComboBox Then SetCtlEnabled Ctl, False
.BackColor = RGB(235, 235, 235) 'Grey
Else
.Locked = False
.Enabled = True
.BackColor = RGB(255, 255, 255)
End If
'Gray the label of CheckBoxes that have been locked
If Ctl.ControlType = acCheckBox And Ctl.Controls.Count >= 1 Then
If Locked Then
Ctl.Controls(0).ForeColor = RGB(128, 128, 128)
Else
Ctl.Controls(0).ForeColor = RGB(0, 0, 0)
End If
End If
End If
End With
Next CtlArrayVar
End Sub
The Full Code
The code below includes required helper functions that I've written about in the past:
- How to Safely Disable Controls in VBA
- The DefocusIfActive() procedure
- The TrySetFocus() Convenience Function
- Throwing Errors in VBA
The code can be copied and pasted into a blank standard module to get a fully-working solution that you can easily integrate into your projects:
Option Compare Database
Option Explicit
' ----------------------------------------------------------------
' Procedure : LockControls
' Date : 5/26/2009
' Author : Mike Wolfe
' Source : https://nolongerset.com/lockcontrols/
' Purpose : Locks or unlocks an arbitrary number of form controls.
' Notes - Label controls can be included in the control array
' and will be hidden in the "Locked" state.
' - Checkbox labels will be set to gray when their associated
' checkbox is locked and black when unlocked.
' ----------------------------------------------------------------
Sub LockControls(Locked As Boolean, ParamArray ctlControls() As Variant) 'vv
On Error Resume Next
Dim CtlArrayVar As Variant
For Each CtlArrayVar In ctlControls
Dim Ctl As Control
Set Ctl = CtlArrayVar
With Ctl
If Ctl.ControlType = acLabel Then
'Hide labels that are 'locked'
Ctl.Visible = Not Locked
Else
If Locked Then
If Ctl.ControlType <> acCommandButton And _
Ctl.ControlType <> acToggleButton Then .Locked = True
If Ctl.ControlType <> acComboBox Then SetCtlEnabled Ctl, False
.BackColor = RGB(235, 235, 235) 'Grey
Else
.Locked = False
.Enabled = True
.BackColor = RGB(255, 255, 255)
End If
'Gray the label of CheckBoxes that have been locked
If Ctl.ControlType = acCheckBox And Ctl.Controls.Count >= 1 Then
If Locked Then
Ctl.Controls(0).ForeColor = RGB(128, 128, 128)
Else
Ctl.Controls(0).ForeColor = RGB(0, 0, 0)
End If
End If
End If
End With
Next CtlArrayVar
End Sub
'----------------------------------------------------------------------------
' Procedure : SetCtlEnabled
' Author : Mike Wolfe
' Source : https://nolongerset.com/setctlenabled/
' Purpose : Safely sets the Enabled property of a form control.
' Params - Ctl: The control whose Enabled property is being set.
' - Enabled: A boolean to indicate whether the control
' should be enabled or not.
' - FallbackCtl: The control to receive focus if the original
' Ctl has focus and is being disabled.
' Notes : If FallbackCtl is not provided, the function will cycle through
' the form's controls collection looking for a suitable
' recipient of the focus.
'----------------------------------------------------------------------------
Sub SetCtlEnabled(Ctl As Control, Enabled As Boolean, _
Optional FallbackCtl As Control)
If Enabled Then
'It's always safe to enable a control
Ctl.Enabled = True
Else
'https://nolongerset.com/defocusifactive/
DefocusIfActive Ctl, FallbackCtl
Ctl.Enabled = False
End If
End Sub
' ----------------------------------------------------------------
' Purpose : Shifts the focus away from a control so that it may be hidden or disabled.
' Author : Mike Wolfe
' Source : https://nolongerset.com/defocusifactive/
' Date : 7/6/2021
' ----------------------------------------------------------------
Sub DefocusIfActive(Ctl As Control, Optional FallbackCtl As Control = Nothing)
'We only want to change focus if the passed control is active
If Not Ctl Is Screen.ActiveControl Then Exit Sub
'Try to set focus to the fallback control if one is provided
If Not FallbackCtl Is Nothing Then
If TrySetFocus(FallbackCtl) Then
'We were able to set focus to the fallback control, our work here is done
Exit Sub
End If
End If
'No fallback control specified or it couldn't take the focus,
' so we have to find another control that can take the focus
'Loop through all the controls
Dim OtherCtl As Object
For Each OtherCtl In Ctl.Parent.Controls
'Skip over the control we're trying to defocus
If Not Ctl Is OtherCtl Then
'If we can set focus to the other control, great...
If TrySetFocus(OtherCtl) Then Exit Sub
'...otherwise we keep trying
End If
Next OtherCtl
'Consider adding a transparent command button to receive the focus:
' https://nolongerset.com/transparent-command-buttons/
MsgBox "No suitable control to pass focus to from " & Ctl.Name
'Consider using Throw instead: https://nolongerset.com/throwing-errors-in-vba/
'Throw "No suitable control to pass focus to from {0}", Ctl.Name
End Sub
' ----------------------------------------------------------------
' Purpose : Attempts to set focus to the passed control.
' Returns True if successful; False otherwise.
' Author : Mike Wolfe
' Source : https://nolongerset.com/trysetfocus/
' ----------------------------------------------------------------
Function TrySetFocus(Ctl As Control) As Boolean
On Error Resume Next
Ctl.SetFocus
TrySetFocus = (Err.Number = 0)
End Function
Cover image created with Microsoft Designer