V
Verity
Hi,
I have a Student form with several Subforms on different "Pages" showing
Student details. I used the script below for locking the main Form and
Subforms and it works well. The problem I have is that one of my Subform's
Controls are not visible when locked (and obviously displays when unlocked).
The other 3 Subforms' Controls are are visible when locked. I'm sure there
is an obvious answer to this, but I have looked through the Subform
properties but I can't see any differences between the visible and
non-visible forms
Thanks very much in advance for your help.
Verity
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 = Trur 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 on " & frm.Name & " at " &
Now()
End Select
Next
Exit_Handler:
Set ctl = Nothing
Exit Function
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & "LockBoundControls")
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
Function LogError(ByVal lngErrNumber As Long, ByVal strErrDescription As
String, _
strCallingProc As String, Optional vParameters, Optional bShowUser As
Boolean = True) As Boolean
On Error GoTo Err_LogError
' Purpose: Generic error handler.
' Logs errors to table "tLogError".
' Arguments: lngErrNumber - value of Err.Number
' strErrDescription - value of Err.Description
' strCallingProc - name of sub|function that generated the error.
' vParameters - optional string: List of parameters to record.
' bShowUser - optional boolean: If False, suppresses display.
' Author: Allen Browne, (e-mail address removed)
Dim strMsg As String ' String for display in MsgBox
Dim rst As DAO.Recordset ' The tLogError table
Select Case lngErrNumber
Case 0
Debug.Print strCallingProc & " called error 0."
Case 2501 'cancelled
'Do nothing.
Case 3314, 2101, 2115 'can't save.
If bShowUser Then
strMsg = "Record cannot be saved at this time." & vbCrLf & _
"Complete the entry, or press <Esc> to undo."
MsgBox strMsg, vbExclamation, strCallingProc
End If
Case Else
If bShowUser Then
strMsg = "Error " & lngErrNumber & ": " & strErrDescription
MsgBox strMsg, vbExclamation, strCallingProc
End If
Set rst = CurrentDb.OpenRecordset("tLogError", , dbAppendOnly)
rst.AddNew
rst![ErrNumber] = lngErrNumber
rst![ErrDescription] = Left$(strErrDescription, 255)
rst![ErrDate] = Now()
rst![CallingProc] = strCallingProc
rst![UserName] = CurrentUser()
rst![ShowUser] = bShowUser
If Not IsMissing(vParameters) Then
rst![Parameters] = Left(vParameters, 255)
End If
rst.Update
rst.Close
LogError = True
End Select
Exit_LogError:
Set rst = Nothing
Exit Function
Err_LogError:
strMsg = "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Calling Proc: " & strCallingProc & vbCrLf & _
"Error Number " & lngErrNumber & vbCrLf & strErrDescription & vbCrLf
& vbCrLf & _
"Unable to record because Error " & Err.Number & vbCrLf &
Err.Description
MsgBox strMsg, vbCritical, "LogError()"
Resume Exit_LogError
End Function
I have a Student form with several Subforms on different "Pages" showing
Student details. I used the script below for locking the main Form and
Subforms and it works well. The problem I have is that one of my Subform's
Controls are not visible when locked (and obviously displays when unlocked).
The other 3 Subforms' Controls are are visible when locked. I'm sure there
is an obvious answer to this, but I have looked through the Subform
properties but I can't see any differences between the visible and
non-visible forms
Thanks very much in advance for your help.
Verity
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 = Trur 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 on " & frm.Name & " at " &
Now()
End Select
Next
Exit_Handler:
Set ctl = Nothing
Exit Function
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & "LockBoundControls")
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
Function LogError(ByVal lngErrNumber As Long, ByVal strErrDescription As
String, _
strCallingProc As String, Optional vParameters, Optional bShowUser As
Boolean = True) As Boolean
On Error GoTo Err_LogError
' Purpose: Generic error handler.
' Logs errors to table "tLogError".
' Arguments: lngErrNumber - value of Err.Number
' strErrDescription - value of Err.Description
' strCallingProc - name of sub|function that generated the error.
' vParameters - optional string: List of parameters to record.
' bShowUser - optional boolean: If False, suppresses display.
' Author: Allen Browne, (e-mail address removed)
Dim strMsg As String ' String for display in MsgBox
Dim rst As DAO.Recordset ' The tLogError table
Select Case lngErrNumber
Case 0
Debug.Print strCallingProc & " called error 0."
Case 2501 'cancelled
'Do nothing.
Case 3314, 2101, 2115 'can't save.
If bShowUser Then
strMsg = "Record cannot be saved at this time." & vbCrLf & _
"Complete the entry, or press <Esc> to undo."
MsgBox strMsg, vbExclamation, strCallingProc
End If
Case Else
If bShowUser Then
strMsg = "Error " & lngErrNumber & ": " & strErrDescription
MsgBox strMsg, vbExclamation, strCallingProc
End If
Set rst = CurrentDb.OpenRecordset("tLogError", , dbAppendOnly)
rst.AddNew
rst![ErrNumber] = lngErrNumber
rst![ErrDescription] = Left$(strErrDescription, 255)
rst![ErrDate] = Now()
rst![CallingProc] = strCallingProc
rst![UserName] = CurrentUser()
rst![ShowUser] = bShowUser
If Not IsMissing(vParameters) Then
rst![Parameters] = Left(vParameters, 255)
End If
rst.Update
rst.Close
LogError = True
End Select
Exit_LogError:
Set rst = Nothing
Exit Function
Err_LogError:
strMsg = "An unexpected situation arose in your program." & vbCrLf & _
"Please write down the following details:" & vbCrLf & vbCrLf & _
"Calling Proc: " & strCallingProc & vbCrLf & _
"Error Number " & lngErrNumber & vbCrLf & strErrDescription & vbCrLf
& vbCrLf & _
"Unable to record because Error " & Err.Number & vbCrLf &
Err.Description
MsgBox strMsg, vbCritical, "LogError()"
Resume Exit_LogError
End Function