Cannot SetFocus > userform control

[Jon von der Heyden]

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:

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

 

[Jon von der Heyden]

Hi Jaafar

Thanks again. Your WatchEvents is just what I needed. I started to customise it for a reusable class and tailor for my little project, and such hit a couple of snags in my revamped code.

Class Module: clsFormEvents

Option Explicit

Private WithEvents mFrm As MSForms.UserForm

Public Event OnEnter(ctl As MSForms.Control)
Public Event OnExit(ctl As MSForms.Control, Cancel As Boolean)

Private moFormControlEvents As clsFormControlEvents
Private mblnFormUnloaded As Boolean
Private mblnCancel As Boolean
Private mctlPrevious As MSForms.Control

Public Property Set Form(frmNew As MSForms.UserForm)
    Set mFrm = frmNew
End Property

Public Property Let Unload(blnUnload)
    mblnFormUnloaded = blnUnload
End Property

Private Sub mFrm_Layout()
    Call WatchEvents
End Sub

Private Sub WatchEvents()
    Set moFormControlEvents = New clsFormControlEvents
    Set moFormControlEvents.FormCtrl = Me
    
    Set mctlPrevious = mFrm.ActiveControl
    RaiseEvent OnEnter(mFrm.ActiveControl)
    
    Do While mblnFormUnloaded = False
        If Not mctlPrevious Is Nothing Then
            If Not mctlPrevious Is mFrm.ActiveControl Then
                RaiseEvent OnExit(mctlPrevious, mblnCancel)
                RaiseEvent OnEnter(mFrm.ActiveControl)
                If mblnCancel Then
                    mctlPrevious.SetFocus
                Else
                    mFrm.ActiveControl.SetFocus
                End If
            End If
        End If
        Set mctlPrevious = mFrm.ActiveControl
        DoEvents
    Loop

End Sub

Private Sub Class_Terminate()
'    Set moFormControlEvents.FormCtrl = Nothing
'    Set moFormControlEvents = Nothing
'    Set mFrm = Nothing
'    mblnFormUnloaded = Empty
'    mblnCancel = Empty
'    Set mctlPrevious = Nothing
End Sub

Class Module: clsFormControlEvents

Option Explicit

Public WithEvents FormCtrl As clsFormEvents

Private Sub FormCtrl_OnEnter(Ctrl As MSForms.Control)
    'do nothing
End Sub

Private Sub FormCtrl_OnExit(Ctrl As MSForms.Control, Cancel As Boolean)
    Dim varArrTag As Variant
    
    If Len(Ctrl.Tag) = 0 Then Exit Sub
    
    varArrTag = Split(Ctrl.Tag, ",")
    'Tags:      (0) Type
    '           (1) Tex Len
    Select Case varArrTag(0)
        Case "Date"
            If Not IsDate(Ctrl.Text) Then
                Ctrl.BackColor = &HC0C0FF
                Ctrl.ControlTipText = "Enter valid date dd/mm/yyyy"
                Beep
            End If
        Case "Numeric"
            If Not IsNumeric(Ctrl.Value) Then
                Ctrl.BackColor = &HC0C0FF
                Ctrl.ControlTipText = "Enter a numeric value"
                Beep
            End If
        Case "Text"
            If IsNumeric(Ctrl.Value) Then
                Ctrl.BackColor = &HC0C0FF
                Ctrl.ControlTipText = "Enter text"
                Beep
            End If
    End Select

End Sub

UserForm Class Module: frmTest

Option Explicit

Private moFormEvents As clsFormEvents
Private mcolFormEvents As Collection

Private Sub UserForm_Initialize()
    If mcolFormEvents Is Nothing Then
        Set mcolFormEvents = New Collection
    End If
    
    Set moFormEvents = New clsFormEvents
    moFormEvents.Unload = False
    Set moFormEvents.Form = Me
    mcolFormEvents.Add moFormEvents
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    moFormEvents.Unload = True
    Set moFormEvents = Nothing
    Set mcolFormEvents = Nothing
End Sub

I have the following problems:

• I have tried various tests but I don't seem to be able to fire up the Class_Terminate event for clsFormEvents, yet I believe I have properly killed the class instance. What am I doing wrong?

• I don't have the option for mFrm_Terminate event in clsFormsEvents, so I couldn't use your normal CleanUp routine. Instead I have used the Unload property in clsFormsEvents which is changed to True using the forms UserForm_QueryClose event. If the event just fired, the first time I click CommandButton1 the form is not unloaded and I need to click it a second time. Any ideas how to resolve this?

 

[Jaafar Tribak]

Hi Jon.

If you could explain what exactly you are trying to do .Also, What Controls do you have on your form and which of them you want to capture their Exit event ?

 

[Jon von der Heyden]

Hi again Jaafar

I tend to routinely use the same methods when building userforms for my projects. I like to exploit the userform controls tag properties, such as:

shtInput,1,Numeric,1-255

I split the tag using comma delimiter and some of the items are used to validate the users input into the control:

shtInput > not used for validation, indicates which sheet the control is 'bound' to.
1 > not used for validation, indicates which column index the control is 'bound' to.
Numeric > used for validation, only numeric values are acceptable
1-255 > used for validation, indicates that the min len of the control input should be 1 (therefore mandatory field), with a max length of 25 characters.

I typically use this on textboxes, but I do also want to have the event available for other controls.

The intention here is to create a re-usable class that I can employ in other future projects. Rather than validate the input into each control when the user clicks the e.g. 'Finish' button, I want the generic validation events to kick in as and when a user completes a control input. If something goes wrong then change the backcolor of the control, assign a tooltip, beep, and even perhaps set focus back to the control. What you see in my previous code is just the start of a re-usable class.

 

[Jaafar Tribak]

Without using a tag to store each control attributes, you can take advantage of the OnExit Event Ctrl and Cancel arguments to make the validation work.

To illustrate this, the form in the following example contains 3 TextBoxes :

-TextBox1 only allows dates ( dd/mm/yyy)
-TextBox2 only allows Text ( no numbers )
-TextBox3 only allows a max number of characters ( 6 )

I have also slightly edited the Form code to correct an overlooked bug.

Workbook example :




Code in the Form module :

Option Explicit

Public Event OnEnter(Ctrl As MSForms.Control)
Public Event OnExit(Ctrl As MSForms.Control, Cancel As Boolean)

Private oXitClass As CtlExitCls
Private bFormUnloaded As Boolean
Private bCancel As Boolean
Private oPrevActiveCtl As MSForms.Control
Private oCol As New Collection


Private Sub UserForm_Layout()

    Call WatchEvents

End Sub

Private Sub UserForm_Terminate()

    Call CleanUp

End Sub

Private Sub CommandButton1_Click()

    Unload Me

End Sub


Private Sub WatchEvents()

    If Not oXitClass Is Nothing Then Exit Sub
    
    
    Set oXitClass = New CtlExitCls
    Set oXitClass.FormCtrl = Me
    
    bFormUnloaded = False
    
    Set oPrevActiveCtl = Me.ActiveControl
    RaiseEvent OnEnter(Me.ActiveControl)
    
    Do While bFormUnloaded = False
        If Not oPrevActiveCtl Is Nothing Then
            If Not oPrevActiveCtl Is Me.ActiveControl Then
                RaiseEvent OnExit(oPrevActiveCtl, bCancel)
                RaiseEvent OnEnter(Me.ActiveControl)
                If bCancel Then
                    oPrevActiveCtl.SetFocus
                Else
                    Me.ActiveControl.SetFocus
                End If
            End If
        End If
        Set oPrevActiveCtl = Me.ActiveControl
        bCancel = False
        DoEvents
    Loop

End Sub

Private Sub CleanUp()

    bFormUnloaded = True
'    RaiseEvent OnExit(oPrevActiveCtl, bCancel)
    Set oXitClass = Nothing
    Set oCol = Nothing
    Set oPrevActiveCtl = Nothing

End Sub

Code in the Class module ( CtlExitCls )

Option Explicit


Public WithEvents FormCtrl As UserForm1


Private Sub FormCtrl_OnEnter(Ctrl As MSForms.Control)

    'do nothing

End Sub

Private Sub FormCtrl_OnExit(Ctrl As MSForms.Control, Cancel As Boolean)
    
    
    Select Case True
    
        Case Ctrl Is FormCtrl.TextBox1 [B][COLOR=SeaGreen]'only date[/COLOR][/B]
        
            If Not IsDate(Ctrl.Text) Then
                Cancel = True
                Ctrl.BackColor = &HC0C0FF
                Ctrl.ControlTipText = "Enter valid date dd/mm/yyyy"
                MsgBox "Enter valid date dd/mm/yyyy."
            Else
                Ctrl.BackColor = &H80000005
            End If
            
            Case Ctrl Is FormCtrl.TextBox2 [B][COLOR=SeaGreen]'only text[/COLOR][/B]
            
                If IsNumeric(Ctrl.Value) Then
                    Cancel = True
                    Ctrl.BackColor = &HC0C0FF
                    Ctrl.ControlTipText = "Enter text"
                    MsgBox "Only Text allowed."
                Else
                    Ctrl.BackColor = &H80000005
                End If
            
            Case Ctrl Is FormCtrl.TextBox3 [B][COLOR=SeaGreen]'Max text len =6[/COLOR][/B]
            
                If Len(Ctrl.Text) > 6 Then
                    Cancel = True
                    Ctrl.BackColor = &HC0C0FF
                    Ctrl.ControlTipText = "Max text len = 6"
                    MsgBox "Max text len = 6 chrs."
                Else
                    Ctrl.BackColor = &H80000005
                End If
    End Select
    
End Sub

I must admit I don't like the idea of using a loop in the background but I haven't noticed any problems so far and the job gets done nicely.

 

[Jaafar Tribak]

Jon.


http://www.box.net/shared/bph84f2ntcFresh Workbook Demo.

Sorry . there was a subtle logic mistake in the UserForm module code that could potentially cause problems of synchronisation between the OnEnter and OnExit events. So please ignore the previous form code and use the one below : ( The Class module code stays the same )


Code in the Form module:

Option Explicit

Public Event OnEnter(Ctrl As MSForms.Control)
Public Event OnExit(Ctrl As MSForms.Control, Cancel As Boolean)

Private oXitClass As CtlExitCls
Private bFormUnloaded As Boolean
Private bCancel As Boolean
Private oPrevActiveCtl As MSForms.Control
Private oCol As New Collection


Private Sub UserForm_Layout()

    Call WatchEvents

End Sub

Private Sub UserForm_Terminate()

    Call CleanUp

End Sub

Private Sub CommandButton1_Click()

    Unload Me

End Sub


Private Sub WatchEvents()

    If Not oXitClass Is Nothing Then Exit Sub
    
    
    Set oXitClass = New CtlExitCls
    Set oXitClass.FormCtrl = Me
    
    bFormUnloaded = False
    
    Set oPrevActiveCtl = Me.ActiveControl
    RaiseEvent OnEnter(Me.ActiveControl)
    
    Do While bFormUnloaded = False
        If Not oPrevActiveCtl Is Nothing Then
            If Not oPrevActiveCtl Is Me.ActiveControl Then
                RaiseEvent OnExit(oPrevActiveCtl, bCancel)
                If bCancel Then
                    oPrevActiveCtl.SetFocus
                Else
                    RaiseEvent OnEnter(Me.ActiveControl)
                    Me.ActiveControl.SetFocus
                End If
            End If
        End If
        Set oPrevActiveCtl = Me.ActiveControl
        bCancel = False
        DoEvents
    Loop

End Sub

Private Sub CleanUp()

    bFormUnloaded = True
'    RaiseEvent OnExit(oPrevActiveCtl, bCancel)
    Set oXitClass = Nothing
    Set oCol = Nothing
    Set oPrevActiveCtl = Nothing

End Sub

 

[Jon von der Heyden]

Hi Jaafar

Do you see issues in the way I have used the two class modules in post #31? The reason I did this was so that I could use this throughout projects and not have to recode the WatchEvents into each form that applies. Fairly pedantic I know but the benefit for me is that I merely save the class modules down to my library directory and then import into new projects.

I haven't had much time recently to continue testing and developing, but I will post back once I play some more with it.

 

[Jaafar Tribak]

Hi Jaafar

Do you see issues in the way I have used the two class modules in post #31? The reason I did this was so that I could use this throughout projects and not have to recode the WatchEvents into each form that applies. Fairly pedantic I know but the benefit for me is that I merely save the class modules down to my library directory and then import into new projects.

I haven't had much time recently to continue testing and developing, but I will post back once I play some more with it.

Hi Jon.

I didn't go through your post #31 properly. I just posted some code that would work as a generic routine in a Class module to handle the OnEnter and OnExit events for all controls on a given userform.

But I do see what you are saying. It's , like you say, much cleaner and portable to have the WatchEvents code inside a seperate Class module.

 

[Jaafar Tribak]

Jon. Here is ,as requested, a generic reusable Class which you could plug into your projects and without the need to recode the WatchEvents routine into each form.

The WatchEventsCls Class has only two Public Methods ( .StartWatching and .StopWatching ) which you can easily call from your Forms to monitor both the OnEnter and OnExit events of each and every Control inside a single generic event handler routine.

Workbook demo.


Code in the Class Module ( WatchEventsCls )

Option Explicit

Public Event OnEnter(Ctrl As MSForms.Control)
Public Event OnExit(Ctrl As MSForms.Control, Cancel As Boolean)

Private bFormUnloaded As Boolean
Private bCancel As Boolean
Private oPrevActiveCtl As MSForms.Control


Public Sub StartWatching(Form As UserForm)

    bFormUnloaded = False
    
    Set oPrevActiveCtl = Form.ActiveControl
    RaiseEvent OnEnter(Form.ActiveControl)
    
    Do While bFormUnloaded = False
        If Not oPrevActiveCtl Is Nothing Then
            If Not oPrevActiveCtl Is Form.ActiveControl Then
                RaiseEvent OnExit(oPrevActiveCtl, bCancel)
                If bCancel Then
                    oPrevActiveCtl.SetFocus
                Else
                    RaiseEvent OnEnter(Form.ActiveControl)
                    Form.ActiveControl.SetFocus
                End If
            End If
        End If
        Set oPrevActiveCtl = Form.ActiveControl
        bCancel = False
        DoEvents
    Loop

End Sub

Public Sub StopWatching()

    Set oPrevActiveCtl = Nothing
    bFormUnloaded = True

End Sub

Code in the UserForm Module :

Option Explicit


Public WithEvents UserFormCtl As WatchEventsCls


Private Sub UserForm_Layout()
    If UserFormCtl Is Nothing Then
        Set UserFormCtl = New WatchEventsCls
        UserFormCtl.StartWatching Me
    End If
End Sub

Private Sub UserForm_Terminate()
    UserFormCtl.StopWatching
    Set UserFormCtl = Nothing
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub UserFormCtl_OnEnter(Ctrl As MSForms.Control)
    'Do nothing
End Sub

Private Sub UserFormCtl_OnExit(Ctrl As MSForms.Control, Cancel As Boolean)

    Select Case True
    
        Case Ctrl Is Me.TextBox1 [COLOR=Green][B]'only date[/B][/COLOR]
        
            If Not IsDate(Ctrl.Text) Then
                Cancel = True
                Ctrl.BackColor = &HC0C0FF
                Ctrl.ControlTipText = "Enter valid date dd/mm/yyyy"
                MsgBox "Enter valid date dd/mm/yyyy."
            Else
                Ctrl.BackColor = &H80000005
            End If
            
            Case Ctrl Is Me.TextBox2 [B][COLOR=Green]'only text[/COLOR][/B]
            
                If IsNumeric(Ctrl.Value) Then
                    Cancel = True
                    Ctrl.BackColor = &HC0C0FF
                    Ctrl.ControlTipText = "Enter text"
                    MsgBox "Only Text allowed."
                Else
                    Ctrl.BackColor = &H80000005
                End If
            
            Case Ctrl Is Me.TextBox3 [B][COLOR=Green]'Max text len =6[/COLOR][/B]
            
                If Len(Ctrl.Text) > 6 Then
                    Cancel = True
                    Ctrl.BackColor = &HC0C0FF
                    Ctrl.ControlTipText = "Max text len = 6"
                    MsgBox "Max text len = 6 chrs."
                Else
                    Ctrl.BackColor = &H80000005
                End If
    End Select

End Sub

I tested the code and haven't noticed any problems so far including the cleanin-up issues you mentioned above.

 

[Jon von der Heyden]

Hi again Jaafar

Thanks for your time on this again. I like your single class much more than my dual class setup. I wonder if you might investigate one little quirk?

Say you have both an enter and exit event, such as this:

In the UserForm:

Private Sub UserFormCtl_OnEnter(Ctrl As MSForms.Control)
    MsgBox "enter"
End Sub

Private Sub UserFormCtl_OnExit(Ctrl As MSForms.Control, Cancel As Boolean)
    MsgBox "exit"
End Sub

Load the form and, using the mouse, click on 'Unload Form'. The events fire, but the command button click event is not triggered. I can't seem to work out why this happens. This is the same problem that I (badly) described in post 31.

 

[Jaafar Tribak]

Jon.

I think this behaviour has nothing to do with the Class module code. It is the normal behaviour of a commandbutton when its _Enter event displays a Msgbox ie : loses focus.

To illustrate this , just comment out the form Layout and Terminate events and add the following Enter event to the commandbutton :

Private Sub CommandButton1_Enter()

    MsgBox "enter"

End Sub

You will find that you have to click the button twice to unload the form despite the Class not being loaded.


If you want to avoid this problem when using the generic Class module, I can think of two options

1- Use the Ctrl argument in the OnEnter/OnExit ( That's why it is there ) to skip firing the events for the commandbutton .- Something like this :

Private Sub UserFormCtl_OnExit(Ctrl As MSForms.Control, Cancel As Boolean)
    If Ctrl Is Me.CommandButton1 Then Exit Sub
End Sub

2- Set the TakeFocusOn_Click Property to False like :

Private Sub UserForm_Layout()
    If UserFormCtl Is Nothing Then
        [B][COLOR=Blue]CommandButton1.TakeFocus******* = False[/COLOR][/B]
        Set UserFormCtl = New WatchEventsCls
        UserFormCtl.StartWatching Me
    End If
End Sub