oxicottin
Learning by pecking away....
- Local time
- Today, 18:19
- Joined
- Jun 26, 2007
- Messages
- 888
Hello, I am trying to validate controls on y form that if their .tag is "Required" and they are null or =0 then highlight the border red and if there is data stay the same. I found a piece of code years ago and am trying to implement it but cant figure out what to change for the below revision.
1) On close I want to run the module below and if there is null or =0 entries then highlight all of them and not just one at a time like the code does as of now.
To call it im using:
MODULE:
1) On close I want to run the module below and if there is null or =0 entries then highlight all of them and not just one at a time like the code does as of now.
To call it im using:
'Valadates controls and if data is missing then it cancels close
If VerifyAccidentEntryForm(Me) = True Then
Cancel = True
End If
MODULE:
Code:
Function VerifyAccidentEntryForm(frm As Form) As Boolean
On Error Resume Next
Dim ctl As Access.Control
Dim strErrCtlName As String
Dim strErrorMessage As String
Dim strMsgName As String
Dim lngErrCtlTabIndex As Long
Dim blnNoValue As Boolean
lngErrCtlTabIndex = 99999999 'more than max #controls
For Each ctl In frm.Controls
With ctl
Select Case .ControlType
Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
If .Tag = "Required" Then
blnNoValue = False
If IsNull(.Value) Or .Value = 0 Then 'Added .Value = 0 for comboboxs with default 0
blnNoValue = True
Else
If .ControlType = acTextBox Then
If Len(.Value) = 0 Then
blnNoValue = True
End If
End If
End If
If blnNoValue Then
strMsgName = vbNullString
If .Controls.Count = 1 Then
strMsgName = .Controls(0).Caption
If Right$(strMsgName, 1) = ":" Then
strMsgName = Trim$(Left$(strMsgName, Len(strMsgName) - 1))
End If
End If
If Len(strMsgName) = 0 Then
strMsgName = .Name
Select Case Left$(strMsgName, 3)
Case "txt", "cbo", "lst", "chk"
strMsgName = Mid(strMsgName, 4)
End Select
End If
strErrorMessage = strErrorMessage & vbCr & _
" " & strMsgName
If .TabIndex < lngErrCtlTabIndex Then
strErrCtlName = .Name
lngErrCtlTabIndex = .TabIndex
End If
End If
End If
Case Else
' Ignore this control
End Select
End With
Next ctl
If Len(strErrorMessage) > 0 Then
MsgBox "The following fields highlighted in red are required before proceding:" & vbCr & _
strErrorMessage, _
vbInformation, "Required Fields Are Missing"
'Highlight the controls border red
frm.Controls(strErrCtlName).BorderColor = vbRed
frm.Controls(strErrCtlName).BorderWidth = 3
frm.Controls(strErrCtlName).SetFocus
VerifyAccidentEntryForm = True
Else
VerifyAccidentEntryForm = False
End If
End Function