Check textbox for future date

[Jimmypop]

Good day again

I would like to when user has entered a date (in any format) inside a textbox that when exiting the textbox it checks whether the date is in the future and then displays a message. Also would it be then able to when exiting that the date be changed to show as format 12-Mar-20?

Please note that there are multiple textboxes where the checks needs to be done and they do not follow each other. They start at TextBox9 then go to 13 then 17 (always increasing by 4). I also cannot put them in a frame seeing as there are other textboxes which contain different info below and next to them.

Any ideas?

 

[Jaafar Tribak]

Overall, this is exactly what I've been looking for and will make userform development so much easier. Thank you very much!

Cool ! Glad you got this working.

And yes, setting a custom TextBoxType Property via an Enum is cleaner and more elegant than using the built-in Tag Property.

 

[bobsan42]

I know it's an old-ish thread, still it's a valuable one.
Since the main purpose of the class is to cover for the lack of Control Events needed in another class, a small modification is in order I think - making it actually raise events to be used in another class which handles the textbox.
So the class can become:

Option Explicit

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, lpiid As GUID) As Long
    Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As LongPtr) As Long
#Else
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, lpiid As GUID) As Long
    Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
#End If

'Actually the events do not need to pass back anything - just ring the bell, but I put in the ctlName just in case
Event OnEnter(ByVal ctlName As String)
Event OnExit(ByVal ctlName As String)
Event BeforeUpdate(ByVal ctlName As String)
Event AfterUpdate(ByVal ctlName As String)

Private oTextBox As Object

Public Property Let SetControlEvents(Optional ByVal TextBox As Object, ByVal SetEvents As Boolean)

    Const S_OK = &H0
    Static lCookie As Long
    Dim tIID As GUID
   
    If Not TextBox Is Nothing Then
        Set oTextBox = TextBox
    End If
       
    If IIDFromString(StrPtr("{00020400-0000-0000-C000-000000000046}"), tIID) = S_OK Then
        Call ConnectToConnectionPoint(Me, tIID, SetEvents, TextBox, lCookie)
        If lCookie Then
            Debug.Print "Connection set for: " & TextBox.name
        Else
            Debug.Print "Connection failed for: " & TextBox.name
        End If
    End If

End Property

Public Sub OnEnter()
    'Attribute OnEnter.VB_UserMemId = &H80018202
    'Debug.Print "[ENTER EVENT] " & oTextBox.name & vbTab & "Value: " & vbTab & oTextBox.Value
    RaiseEvent OnEnter(oTextBox.name)
End Sub

Public Sub OnExit(ByVal Cancel As MSForms.ReturnBoolean)
    ' Attribute OnExit.VB_UserMemId = &H80018203
    'Debug.Print "[EXIT EVENT] " & oTextBox.name & vbTab & "Value: " & vbTab & oTextBox.Value
    RaiseEvent OnExit(oTextBox.name)
End Sub

Public Sub BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    'Attribute BeforeUpdate.VB_UserMemId = &H80018201
    'Debug.Print "[BEFORE_UPDATE EVENT] " & oTextBox.name & vbTab & "Value: " & vbTab & oTextBox.Value
    RaiseEvent BeforeUpdate(oTextBox.name)
End Sub

Public Sub AfterUpdate()
    'Attribute AfterUpdate.VB_UserMemId = &H80018200
    'Debug.Print "[AFTER_UPDATE EVENT] " & oTextBox.name & vbTab & "Value: " & vbTab & oTextBox.Value
    RaiseEvent AfterUpdate(oTextBox.name)
End Sub

Private Sub Class_Terminate()
    Debug.Print "Class instance treminated and memory released properly."
End Sub

then in your main textbox-handling class to have all events covered you do something like:

Option Explicit
Private WithEvents pTextBox As MSForms.TextBox
Private WithEvents oClass As ClassXExtTextBoxEvents
 ...
Sub hook(ByRef ctlTextBox As MSForms.TextBox)
    If Not pTextBox Is Nothing Then Set pTextBox = Nothing
    Set pTextBox = ctlTextBox
   
    Set oClass = New ClassXExtTextBoxEvents
    oClass.SetControlEvents(pTextBox) = True
End Sub
Private Sub oClass_OnEnter(ByVal ctlName As String)
    Debug.Print "[ENTER EVENT] " & ctlName & vbTab & "Value: " & vbTab & pTextBox.Value
End Sub

Private Sub oClass_OnExit(ByVal ctlName As String)
    Debug.Print "[EXIT EVENT] " & ctlName & vbTab & "Value: " & vbTab & pTextBox.Value
End Sub

Private Sub pTextBox_Change()
    Debug.Print Now(), pTextBox.name, "Event: " & "Change"
    Dim txt As String
    txt = pTextBox.text
End Sub
...
Private Sub Class_Terminate()
    On Error Resume Next
    Set pTextBox = Nothing
    oClass.SetControlEvents = False
    Set oClass = Nothing
End Sub

... just an idea

 

[Jaafar Tribak]

@bobsan42

Thanks for sharing.

In order to make the Class/Code more Object Oriented Programming compliant, the event handler should be located in the Consumer/Client of the Class.

The client of the Class, in our present scenario is the container of the textbox controls, that is the UserForm.

The user of the Class should be allowed to write/edit the event handlers in the client userform module only. (Not in the Class Module)

Imagine we had several userforms using the same Class but each with a different implementation of it ... Ideally, each UserForm is supposed to be able to handle its control events in their own separate manner and with their own diff code/implementation if needed, without the need to alter the class code. This keeps the code in the Class insulated from being messed with, makes the use of the Class very easy, Plus, it gives each client UserForm plenty of flexibility.

Also, notice that I have added the the Cancel Parameter to the Exit and BeforeUpdate events, which were missing so far.

So in order to obey by the above mentioned OOP rules , I am posting the following alternative code:

File Demo:
TextBoxEvents_OOP.xlsm







1- Class Code ( CTextBoxEvents )

Option Explicit

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

#If VBA7 Then
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, lpiid As GUID) As Long
    Private Declare PtrSafe Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As LongPtr) As Long
    Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long
 
    Private hwnd As LongPtr

#Else
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, lpiid As GUID) As Long
    Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long
    Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As Long) As Long
 
    Private hwnd As Long

#End If

Private WithEvents CmndBras  As CommandBars

Private oClientForm As Object
Private oCurrentTextBox As MSForms.TextBox
Private sClassInstanceName As String

Event OnEnter(ByVal TextBox As MSForms.TextBox)
Event OnExit(ByVal TextBox As MSForms.TextBox, ByRef Cancel As MSForms.ReturnBoolean)
Event BeforeUpdate(ByVal TextBox As MSForms.TextBox, ByRef Cancel As MSForms.ReturnBoolean)
Event AfterUpdate(ByVal TextBox As MSForms.TextBox)


' __________________________________ CLASS PUBLIC METHOD ________________________________________

Public Property Let HookEvents(ClassInstanceName As String, Optional ByVal TextBox As MSForms.TextBox, ByVal SetEvents As Boolean)

    Const S_OK = &H0
    Static lCookie As Long
    Dim tIID As GUID
 
    If Not TextBox Is Nothing Then
        Set oCurrentTextBox = TextBox
        Set oClientForm = GetUserForm(TextBox)
        sClassInstanceName = ClassInstanceName
   
        Set CmndBras = Application.CommandBars
        Call IUnknown_GetWindow(oClientForm, VarPtr(hwnd))
    End If
    If IIDFromString(StrPtr("{00020400-0000-0000-C000-000000000046}"), tIID) = S_OK Then
        If ConnectToConnectionPoint(Me, tIID, SetEvents, TextBox, lCookie) = S_OK Then
            'Debug.Print oCurrentTextBox.Name & IIf(SetEvents, " connected ", " disconnected") & " successfully."
        Else
            'Debug.Print "Connection failed for: " & oCurrentTextBox.Name
        End If
    End If
 
End Property

' __________________________________ TEXTBOX CONTROL EVENTS ________________________________________

Public Sub OnEnter()
    'Attribute OnEnter.VB_UserMemId = &H80018202
    Dim oThis As CTextBoxEvents
    Set oThis = Me
    Call CallByName(oClientForm, sClassInstanceName, VbSet, oThis)
    Set oThis = Nothing
    RaiseEvent OnEnter(oCurrentTextBox)
End Sub

Public Sub OnExit(ByVal Cancel As MSForms.ReturnBoolean)
    'Attribute OnExit.VB_UserMemId = &H80018203
    RaiseEvent OnExit(oCurrentTextBox, Cancel)
End Sub

Public Sub BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    'Attribute BeforeUpdate.VB_UserMemId = &H80018201
    RaiseEvent BeforeUpdate(oCurrentTextBox, Cancel)
End Sub

Public Sub AfterUpdate()
    'Attribute AfterUpdate.VB_UserMemId = &H80018200
    RaiseEvent AfterUpdate(oCurrentTextBox)
End Sub


' __________________________________ PRIVATE ROUTINES ________________________________________

Private Function GetUserForm(ByVal Ctrl As MSForms.Control) As Object
    Dim oTmp As Object
    Set oTmp = Ctrl.Parent
    Do While TypeOf oTmp Is MSForms.Control
        Set oTmp = oTmp.Parent
    Loop
    Set GetUserForm = oTmp
End Function

Private Sub CmndBras_OnUpdate()
    If IsWindow(hwnd) = 0 Then
        HookEvents(sClassInstanceName, oCurrentTextBox) = False
    End If
End Sub

Private Sub Class_Terminate()
    'Debug.Print "Class instance treminated and memory released properly related to: " & oCurrentTextBox.Name
    Set oCurrentTextBox = Nothing:  Set oClientForm = Nothing:  Set CmndBras = Nothing
End Sub

2- Class Usage First Example ( UserForm Module)

Option Explicit

Public WithEvents oTextBox As CTextBoxEvents

Private Sub UserForm_Initialize()
    Dim oCtrl As Control
    For Each oCtrl In Me.Controls
        If TypeOf oCtrl Is MSForms.TextBox Then
            Set oTextBox = New CTextBoxEvents
            oTextBox.HookEvents(ClassInstanceName:="oTextBox", TextBox:=oCtrl) = True
        End If
    Next oCtrl
End Sub

' ________________________________ EVENT HANDLERS _____________________________________


Private Sub oTextBox_OnEnter(ByVal TextBox As MSForms.TextBox)
    With ListBox1
        .AddItem "[" & .ListCount + 1 & "]   " & TextBox.Name & " ... Enter Event"
        .ListIndex = .ListIndex + 1
    End With
End Sub

Private Sub oTextBox_OnExit(ByVal TextBox As MSForms.TextBox, Cancel As MSForms.ReturnBoolean)
    With ListBox1
        .AddItem "[" & .ListCount + 1 & "]   " & TextBox.Name & " ... Exit Event"
        .ListIndex = .ListIndex + 1
    End With
End Sub

Private Sub oTextBox_BeforeUpdate(ByVal TextBox As MSForms.TextBox, Cancel As MSForms.ReturnBoolean)
    With ListBox1
        .AddItem "[" & .ListCount + 1 & "]   " & TextBox.Name & " ... BeforeUpdate Event"
        .ListIndex = .ListIndex + 1
    End With
End Sub

Private Sub oTextBox_AfterUpdate(ByVal TextBox As MSForms.TextBox)
    With ListBox1
        .AddItem "[" & .ListCount + 1 & "]   " & TextBox.Name & " ... AfterUpdate Event"
        .ListIndex = .ListIndex + 1
    End With
End Sub

3- Second Example in UserForm2

Option Explicit

Public WithEvents oTextBox2 As CTextBoxEvents

Private Sub UserForm_Initialize()
    Dim oCtrl As Control
    For Each oCtrl In Me.Controls
        If TypeOf oCtrl Is MSForms.TextBox Then
            Set oTextBox2 = New CTextBoxEvents
            oTextBox2.HookEvents(ClassInstanceName:="oTextBox2", TextBox:=oCtrl) = True
        End If
    Next oCtrl
End Sub


' ________________________________ EVENT HANDLERS _____________________________________

Private Sub oTextBox2_OnEnter(ByVal TextBox As MSForms.TextBox)
    With TextBox
        .BackColor = &HAAFF00
        .TextAlign = fmTextAlignCenter
        If Not TextBox Is Me.TextBox4 Then
            .Text = "Active"
        End If
    End With
End Sub

Private Sub oTextBox2_OnExit(ByVal TextBox As MSForms.TextBox, Cancel As MSForms.ReturnBoolean)
    With TextBox
        .BackColor = &HFFFFFF
        If TextBox Is Me.TextBox4 Then
            If .Text = "" Then
                Cancel = True
                MsgBox "Oops!!" & vbLf & _
                       "You can't exit this TextBox unless you enter some text in it.", vbExclamation
            End If
        End If
        .Text = ""
    End With
End Sub

 

[senatorsanchez]

I just want to thank you all for continuing this thread from 2002(4?) to now. This is so helpful.

I am working through adapting this for use when there are text boxes or combo boxes in frames. If I come up with a solution to that I will share it, unless someone else already has boiler plate.

Jaafar you are a legend.

 

[senatorsanchez]

Edit: the frame handling is already in there. Doh! Sorry.