Jon von der Heyden
MrExcel MVP, Moderator
- Joined
- Apr 6, 2004
- Messages
- 10,910
- Office Version
- 365
- Platform
- Windows
Hi All
Posting a rather lengthy class here. Everything works as expected, except the .SetFocus line. Testing on textboxes, the control in question is not selected, yet the error message displays:
clsFormsControlsEvents:
Posting a rather lengthy class here. Everything works as expected, except the .SetFocus line. Testing on textboxes, the control in question is not selected, yet the error message displays:
clsFormsControlsEvents:
Code:
Private WithEvents m_TextBoxEvents As MSForms.TextBox
Private WithEvents m_ComboBoxEvents As MSForms.ComboBox
Private m_blnOk As Boolean 'boolean to tell us whether or not all controls ok
Public Property Set Control(ctlNew As MSForms.Control)
Select Case TypeName(ctlNew)
Case "TextBox"
Set m_TextBoxEvents = ctlNew
Case "ComboBox"
Set m_ComboBoxEvents = ctlNew
End Select
End Property
'there's no exit event, so we use key/mouse down events, check for tab and click to a different control
Private Sub m_TextBoxEvents_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyTab Then
Call ControlEventTriggered(m_TextBoxEvents)
End If
End Sub
Private Sub m_TextBoxEvents_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
End Sub
Private Sub ControlEventTriggered(ByVal ctl As MSForms.Control)
Dim varArrTag As Variant
varArrTag = Split(ctl.Tag, ",")
'tag: (0) = Mandatory boolean
' (1) = Data type
' (2) = Length
With ctl
If varArrTag(0) = True And Len(.Object.Value) = 0 Then
[COLOR=Red][B].SetFocus[/B][/COLOR]
MsgBox Prompt:="Mandatory field!", Buttons:=vbExclamation + vbOKOnly, Title:=ctl.Parent.Name
m_blnOk = False
GoTo Finally
End If
Select Case varArrTag(1)
Case "date"
If Not IsDate(.Object.Value) Then
[COLOR=Red][B].SetFocus[/B][/COLOR]
MsgBox Prompt:="Invalid date!", Buttons:=vbExclamation + vbOKOnly, Title:=ctl.Parent.Name
m_blnOk = False
GoTo Finally
End If
Case "numeric"
If Not IsNumeric(.Object.Value) Then
[COLOR=Red][B].SetFocus[/B][/COLOR]
MsgBox Prompt:="Number field!", Buttons:=vbExclamation + vbOKOnly, Title:=ctl.Parent.Name
m_blnOk = False
GoTo Finally
End If
'more cases here
End Select
If Len(.Object.Value) > CLng(varArrTag(2)) Then
[COLOR=Red][B].SetFocus[/B][/COLOR]
MsgBox Prompt:="Max " & varArrTag(2) & " chars!", Buttons:=vbExclamation + vbOKOnly, Title:=ctl.Parent.Name
m_blnOk = False
GoTo Finally
End If
End With
m_blnOk = True
Finally:
Erase varArrTag
End Sub
Private Sub Class_Terminate()
Set m_TextBoxEvents = Nothing
Set m_ComboBoxEvents = Nothing
m_blnOk = Empty
End Sub