Hello,
I am trying a different approach to handle required fields. I'm testing another code and where it highlights required fields works great. However, I need it to un-highlight after the required field has been filled. Below is the code that handles the required fields. Any suggestions?
Below is the full code that has been placed in a Module
The code is being called in the Form_Load event.
FYI - this is someone else's code I found online and wanted to try out.
Thank you
I am trying a different approach to handle required fields. I'm testing another code and where it highlights required fields works great. However, I need it to un-highlight after the required field has been filled. Below is the code that handles the required fields. Any suggestions?
Code:
Public Function SetupRequiredFields(frm As Form)
On Error GoTo Err_Handler
Dim rs As DAO.Recordset 'Recordset of the form.
Dim ctl As Access.Control 'Each control on the form.
Dim strField As String 'Name of the field a control is bound to.
Set rs = frm.Recordset
For Each ctl In frm.Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox
'Ignore unbound, or bound to an expression.
strField = ctl.ControlSource
If (strField <> vbNullString) And Not (strField Like "=*") Then
With rs(strField)
If (.Required) Or (.ValidationRule Like "*Is Not Null*") Then
ctl.BackColor = mlngcRequiredBackColor
Call MarkAttachedLabel(ctl)
End If
End With
End If
End Select
Next
SetupRequiredFields = True
Exit_Handler:
Set ctl = Nothing
Set rs = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & err.Number & ": " & err.Description, vbExclamation, "SetupRequiredFields()"
Resume Exit_Handler
End FunctionBelow is the full code that has been placed in a Module
Code:
Option Compare Database
Option Explicit
'The RGB value to use as a control's Back Color when it has focus.
Private Const mlngcFocusBackColor = &HB0FFFF
'The RGB value to use as Back Color if a control is bound to a required field.
Private Const mlngcRequiredBackColor = &HD0D0FF
'These constants are for assigning/reading the Tag property.
Private Const mstrcTagBackColor = "UsualBackColor"
Private Const mstrcTagSeparator = ";"
Private Const mstrcTagAssignmnent = "="
Public Function SetupForm(frm As Form, Optional iSetupWhat As Integer = &H7FFF)
Const iSetupRequired = 1
Const iSetupFocusColor = 2
If (iSetupWhat And iSetupRequired) Then Call SetupRequiredFields(frm)
If (iSetupWhat And iSetupFocusColor) Then Call SetupFocusColor(frm)
End Function
Public Function SetupFocusColor(frm As Form)
On Error GoTo Err_Handler
Dim ctl As Access.Control 'Each control on the form.
For Each ctl In frm.Controls
With ctl
Select Case .ControlType
Case acTextBox, acComboBox, acListBox
If (.OnGotFocus = vbNullString) And (.OnLostFocus = vbNullString) Then
.OnGotFocus = "=Hilight([" & .Name & "], True)"
.OnLostFocus = "=Hilight([" & .Name & "], False)"
.Tag = .Tag & IIf(.Tag <> vbNullString, mstrcTagSeparator, Null) & _
mstrcTagBackColor & mstrcTagAssignmnent & .BackColor
End If
End Select
End With
Next
SetupFocusColor = True
Exit_Handler:
Set ctl = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & err.Number & ": " & err.Description, vbExclamation, "SetupFocusColor()"
Resume Exit_Handler
End Function
Public Function SetupRequiredFields(frm As Form)
On Error GoTo Err_Handler
Dim rs As DAO.Recordset 'Recordset of the form.
Dim ctl As Access.Control 'Each control on the form.
Dim strField As String 'Name of the field a control is bound to.
Set rs = frm.Recordset
For Each ctl In frm.Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox
'Ignore unbound, or bound to an expression.
strField = ctl.ControlSource
If (strField <> vbNullString) And Not (strField Like "=*") Then
With rs(strField)
If (.Required) Or (.ValidationRule Like "*Is Not Null*") Then
ctl.BackColor = mlngcRequiredBackColor
Call MarkAttachedLabel(ctl)
End If
End With
End If
End Select
Next
SetupRequiredFields = True
Exit_Handler:
Set ctl = Nothing
Set rs = Nothing
Exit Function
Err_Handler:
MsgBox "Error " & err.Number & ": " & err.Description, vbExclamation, "SetupRequiredFields()"
Resume Exit_Handler
End Function
Public Function Hilight(ctl As Access.Control, bOn As Boolean)
' bOn = flag: True if receiving focus, False if losing focus.
Dim strBackColor As String
If bOn Then
'Assign the 'got focus' color.
ctl.BackColor = mlngcFocusBackColor
Else
'Restore the color from the control's Tag property (white if not found.)
strBackColor = ReadFromTag(ctl, mstrcTagBackColor)
If IsNumeric(strBackColor) Then
ctl.BackColor = Val(strBackColor)
Else
ctl.BackColor = vbWhite
End If
End If
End Function
Private Function MarkAttachedLabel(ctl As Access.Control)
On Error GoTo Err_Handler
With ctl.Controls(0)
If Not .Caption Like "*
[*]" Then
.Caption = .Caption & "*"
.FontBold = True
.ForeColor = vbRed
End If
End With
Exit_Handler:
Exit Function
Err_Handler:
Resume Exit_Handler
End Function
Private Function ReadFromTag(ctl As Control, strName As String) As String
Dim varArray As Variant
Dim strValue As String
Dim i As Long
If ctl.Tag <> vbNullString Then
varArray = Split(ctl.Tag, mstrcTagSeparator)
If IsArray(varArray) Then
For i = LBound(varArray) To UBound(varArray)
If varArray(i) Like strName & mstrcTagAssignmnent & "*" Then
ReadFromTag = Mid(varArray(i), Len(strName) + Len(mstrcTagAssignmnent) + 1&)
End If
Next
End If
End If
End FunctionThe code is being called in the Form_Load event.
FYI - this is someone else's code I found online and wanted to try out.
Thank you
