Provided by Allen Browne, September 2005. Last updated: April 2010.
It is very easy to overwrite data accidentally in Access. Setting a form's AllowEdits property prevents that, but also locks any unbound controls you want to use for filtering or navigation. This solution locks only the bound controls on a form and handles its subforms as well.
First, the code saves any edits in progress, so the user is not stuck with a half-edited form. Next it loops through all controls on the form, setting the Locked property of each one unless the control:
If it finds a subform, the function calls itself recursively. Nested subforms are therefore handled to any depth. If you do not want your subform locked, name it in the exception list.
The form's AllowDeletions property is toggled as well. The code changes the text on the command button to indicate whether clicking again will lock or unlock.
To help the user remember they must unlock the form to edit, add a rectangle named rctLock around the edge of your form. The code shows this rectangle when the form is locked, and hides it when unlocked.
To use the code:
Private Sub cmdLock_Click() Dim bLock As Boolean bLock = IIf(Me.cmdLock.Caption = "&Lock", True, False) Call LockBoundControls(Me, bLock) End Sub
Note that if your form has any disabled controls, changing their Locked property affects the way they look. To avoid this, add them to the exception list.
Public Function LockBoundControls(frm As Form, bLock As Boolean, ParamArray avarExceptionList()) On Error GoTo Err_Handler 'Purpose: Lock the bound controls and prevent deletes on the form any its subforms. 'Arguments frm = the form to be locked ' bLock = True to lock, False to unlock. ' avarExceptionList: Names of the controls NOT to lock (variant array of strings). 'Usage: Call LockBoundControls(Me. True) Dim ctl As Control 'Each control on the form Dim lngI As Long 'Loop controller. Dim bSkip As Boolean 'Save any edits. If frm.Dirty Then frm.Dirty = False End If 'Block deletions. frm.AllowDeletions = Not bLock For Each ctl In frm.Controls Select Case ctl.ControlType Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox, acOptionButton, acToggleButton 'Lock/unlock these controls if bound to fields. bSkip = False For lngI = LBound(avarExceptionList) To UBound(avarExceptionList) If avarExceptionList(lngI) = ctl.Name Then bSkip = True Exit For End If Next If Not bSkip Then If HasProperty(ctl, "ControlSource") Then If Len(ctl.ControlSource) > 0 And Not ctl.ControlSource Like "=*" Then If ctl.Locked <> bLock Then ctl.Locked = bLock End If End If End If End If Case acSubform 'Recursive call to handle all subforms. bSkip = False For lngI = LBound(avarExceptionList) To UBound(avarExceptionList) If avarExceptionList(lngI) = ctl.Name Then bSkip = True Exit For End If Next If Not bSkip Then If Len(Nz(ctl.SourceObject, vbNullString)) > 0 Then ctl.Form.AllowDeletions = Not bLock ctl.Form.AllowAdditions = Not bLock Call LockBoundControls(ctl.Form, bLock) End If End If Case acLabel, acLine, acRectangle, acCommandButton, acTabCtl, acPage, acPageBreak, acImage, acObjectFrame 'Do nothing Case Else 'Includes acBoundObjectFrame, acCustomControl Debug.Print ctl.Name & " not handled " & Now() End Select Next 'Set the visual indicators on the form. On Error Resume Next frm.cmdLock.Caption = IIf(bLock, "Un&lock", "&Lock") frm!rctLock.Visible = bLock Exit_Handler: Set ctl = Nothing Exit Function Err_Handler: MsgBox "Error " & Err.Number & " - " & Err.Description Resume Exit_Handler End Function Public Function HasProperty(obj As Object, strPropName As String) As Boolean 'Purpose: Return true if the object has the property. Dim varDummy As Variant On Error Resume Next varDummy = obj.Properties(strPropName) HasProperty = (Err.Number = 0) End Function
Home | Index of tips | Top |