Todd Harpham
toddharpham at qb3net.com
Mon Apr 1 00:57:27 CDT 2013
Hello -
As seen in earlier posts to this thread, there is more than one way to
manage the controls on a form. Here's another alternative.
It's been a while since I've had this particular requirement but this is
some code I wrote to enable and show form controls based on values loaded to
the control tag.
As part of the form load, the SetControlLocks sub is called.
The sub loops through the Controls collection for the form. For each
control:
If there is no value loaded to the tag, nothing is done.
If something has been loaded to the tag, then enable/disable the control
based on the tag value.
The logic can get quite involved. For the purposes of the sample code below,
I actually stripped out a lot of what was happening in the original app, and
set up some simpler logic for two types of employees (Manager and Rep).
Variables mblnMgr and mblnRep indicate the employee's role.
Todd
Option Explicit
Option Compare Database
' Tags indicating employee Role
Private mblnMgr As Boolean
Private mblnRep As Boolean
Public Sub SetControlLocks(frm As Form)
Dim blnErr As Boolean
Dim strTag As String
Dim strCtl As String
Dim ctl As Control
On Error Resume Next
With frm
For Each ctl In .Controls
blnErr = False
With ctl
strCtl = .Name
Select Case .ControlType
Case acCheckBox, acComboBox, _
acListBox, _
acOptionGroup, acOptionButton, _
acPage, acTabCtl, acSubform, _
acTextBox, acToggleButton
' If the control tag is not blank, apply control security
If Len(Nz(.Tag, "")) > 0 Then
strTag = .Tag
' start with default of 'Locked' & disabled
.Locked = True
.Enabled = False
' Check for Manager
If mblnMgr Then
If strTag = "Mgr" Or strTag = "Rep" Then
.Locked = False
.Enabled = True
End If
' Check for Rep
ElseIf mblnRep Then
If strTag = "Rep" Then
.Locked = False
.Enabled = True
End If 'If strTag = "Rep"
End If 'If mblnMgr Then
End If 'If Len(Nz(.Tag, "")) > 9
End Select 'Select Case .ControlType
End With 'With ctl
Next ctl 'For Each ctl In .Controls
End With 'With frm
ExitSub:
On Error Resume Next
Set ctl = Nothing
Err.Clear
Exit Sub
ErrorHandler:
Select Case Err
' Error 2164: Can't disable a control while it has the focus
' Try to move focus to next control. If you hit the error again
' while working on the same control, bypass the disable step.
Case 2164
If blnErr Then
Resume Next
Else
blnErr = True
TabNextControl frm
End If
Resume
Case Else
MsgBox "Error " & Err.Description & "(" & Err.Number & ")"
End Select
End Sub
Private Sub TabNextControl(Optional frm As Access.Form)
Dim blnEnabled As Boolean
Dim blnDone As Boolean
Dim intTest As Integer
Dim intInd As Integer
Dim ctl As Control
On Error Resume Next
If frm Is Nothing Then
Set frm = Screen.ActiveForm
End If 'If frm Is Nothing
intInd = Nz(frm.ActiveControl.TabIndex) + 1
With frm
Do Until blnDone
intInd = intInd Mod .Controls.Count
For Each ctl In .Controls
With ctl
intTest = .TabIndex
If intTest = intInd Then
blnEnabled = .Enabled And .TabStop = True
If blnEnabled Then
.SetFocus
blnDone = True
Exit For
End If 'If blnEnabled
End If 'If intTest = intInd
End With 'With ctl
Next 'For Each ctl In .Controls
intInd = intInd + 1
' Prevent endless loop
If intInd > 150 Then
Stop
End If 'If intInd > 150
Loop 'Do Until blnDone
End With 'With frm
ExitSub:
Set ctl = Nothing
Err.Clear
End Sub