Follow these steps :
1- Add a new UserForm to your vbproject and add to it a few TextBoxes for testing the events.
2- Place this code in the UserForm Module:
Code:
Option Explicit
Private Sub UserForm_Initialize()
Dim oCtrl As Control, oClass As CTextBoxEvents
For Each oCtrl In Me.Controls
If TypeOf oCtrl Is msforms.TextBox Then
Set oClass = New CTextBoxEvents
oClass.SetControlEvents(oCtrl) = True
End If
Next oCtrl
End Sub
3-Add a new Class Module to your vbproject and give it the name of
CTextBoxEvents . This class module will be the one responsible for sinking the textbox(es) events.
4- Place the following code in the Class Module :
VBA Code:
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
Private oTextBox As Object
Public Property Let SetControlEvents(ByVal TextBox As Object, ByVal SetEvents As Boolean)
Const S_OK = &H0
Static lCookie As Long
Dim tIID As GUID
Set oTextBox = TextBox
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
'Attribute OnEnter.VB_UserMemId = &H80018202
Debug.Print "[ENTER EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value
End Sub
Public Sub OnExit(ByVal Cancel As MsForms.ReturnBoolean)
Attribute OnExit.VB_UserMemId = &H80018203
' Attribute OnExit.VB_UserMemId = &H80018203
Debug.Print "[EXIT EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value
End Sub
Public Sub BeforeUpdate(ByVal Cancel As MsForms.ReturnBoolean)
Attribute BeforeUpdate.VB_UserMemId = &H80018201
'Attribute BeforeUpdate.VB_UserMemId = &H80018201
Debug.Print "[BEFORE_UPDATE EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value
End Sub
Public Sub AfterUpdate()
Attribute AfterUpdate.VB_UserMemId = &H80018200
'Attribute AfterUpdate.VB_UserMemId = &H80018200
Debug.Print "[AFTER_UPDATE EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value
End Sub
You will notice the Attribute statement in RED in each of the event procedures which won't let the project compile... This is not an issue. Just ignore that for the moment and carry on with the remaining steps.
5- Save your workbook
6- Export the class module as a CLS file to disk.
7- Delete the Class Module from the vbe project.
8- Import the exported cls file from step 6 (the RED Event Procedure Attribute statements are now invisible in the imported class module)
9- Save the workbook again.
10- Now, load the UserForm and the textboxes events should now be successfully sinked.
Although the above steps are required only once, they are still cumbersome and confusing. I started investigating a more straightforward alternative (albeit more difficult) lately but I never finished it.
Regards.
PS: Although, the above userform code works fine, it is
technically incomplete as it should properly
disconnect the classes from the connectable textboxes once the userform is closed. This should be easily done with little code.
