0

In this post, I was shown how to create a class for a textbox, so I could use the Textbox_Change event to run other code, like this example from @Storax:

Option Explicit

Public WithEvents tb As MSForms.TextBox
' just to keep track of the box in the grid
Public x As Long
Public y As Long

' Just a simple example for the change event.
' you could  use x and y to tell the different textboxes apart
Private Sub tb_Change()
    Debug.Print tb.Text, x, y
End Sub

Unfortunately, it works too well.

  • It fires on every keystroke in the textbox. I think I can work around that, but I'd really like it to wait until the user has finished typing, or tabbed to another control. But Textbox controls in a class module do not have Enter or Exit events.

  • In my main module, I have lines that change the value of the text box, but I don't always want it to trigger the event. I've tried:

       Application.EnableEvents = False
       Textbox1.value = "Default"
       Application.EnableEvents = True
    

...but the Change event triggers anyway.

Shawn V. Wilson
  • 1,002
  • 3
  • 17
  • 42

2 Answers2

2

It is indeed possible. Based on this post you need to copy the following code into a textfile, name it catchevent.cls and import it as a class module. This is important as it contains attributes which you cannot enter in the VBE of Excel.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CatchEvents"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Type GUID
      Data1 As Long
      Data2 As Integer
      Data3 As Integer
      Data4(0 To 7) As Byte
End Type

#If VBA7 And Win64 Then
      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 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 EventGuide As GUID
Private Ck As Long
Private ctl As Object
'All Other Control-Events also possible
Public Sub OnEnter()
Attribute OnEnter.VB_UserMemId = -2147384830
  Select Case TypeName(ctl)
  Case "TextBox": MsgBox "Your code for " & ctl.Name & " here!"
  Case Else: MsgBox "You entered no TextBox but another control (" & ctl.Name & ")!"
  End Select
End Sub

Public Sub OnExit(ByVal Cancel As MSForms.ReturnBoolean )
Attribute OnExit.VB_UserMemId = -2147384829
  Select Case TypeName(ctl)
  Case "TextBox": MsgBox "Your code for " & ctl.Name & " here!"
  Case Else: MsgBox "You left no TextBox but another control (" & ctl.Name & ")!"
  End Select
End Sub

Public Sub ConnectAllEvents(ByVal Connect As Boolean)
      With EventGuide
          .Data1 = &H20400
          .Data4(0) = &HC0
          .Data4(7) = &H46
      End With
      ConnectToConnectionPoint Me, EventGuide, Connect, ctl, Ck, 0&
End Sub

Public Property Let Item(Ctrl As Object)
      Set ctl = Ctrl
      Call ConnectAllEvents(True)
End Property

Public Sub Clear()
      If (Ck <> 0) Then Call ConnectAllEvents(False)
      Set ctl = Nothing
End Sub

Then you need to adjust your code in the userform like that

Option Explicit

Private AllControls(0 To 49) As New CatchEvents
Dim Grid(1 To 10, 1 To 5) As MSForms.TextBox

Private Sub UserForm_Initialize()

Dim x As Long
Dim y As Long
Dim i As Long

For x = 1 To 10
    For y = 1 To 5
        Set Grid(x, y) = Me.Controls.Add("Forms.Textbox.1")
        
        AllControls(i).Item = Grid(x, y)
        i = i + 1
        
        
        With Grid(x, y)
            .Name = "TextBox_" & x & "_" & y
            .Width = 50
            .Height = 20
            .Left = y * .Width
            .Top = x * .Height
            .SpecialEffect = fmSpecialEffectFlat
            .BorderStyle = fmBorderStyleSingle
        End With
    Next y
Next x

End Sub

Further reading here

PS: Why you need to import code sometimes: Code Attributes https://stackoverflow.com/a/34688164/6600940

Storax
  • 11,158
  • 3
  • 16
  • 33
0

Use a class level variable to track where or not you want to listen for grid events.

Private Grid(1 To 10, 1 To 5) As New TextBoxListener
Private GridEventsEnabled As Boolean

Public Sub TextBoxGridChange(TextBox As MSForms.TextBox)
    If Not GridEventsEnabled Then Exit Sub
    
    Debug.Print TextBox.Value
End Sub

Private Sub UserForm_Initialize()
    
    Dim x As Long
    Dim y As Long

    For x = 1 To 10
        For y = 1 To 5
            With Grid(x, y)
                Set .TextBox = Me.Controls.Add("Forms.Textbox.1")
                Set .UserForm = Me
                With .TextBox
                    .Name = "TextBox_" & x & "_" & y
                    .Width = 50
                    .Height = 20
                    .Left = y * .Width
                    .Top = x * .Height
                    .SpecialEffect = fmSpecialEffectFlat
                    .BorderStyle = fmBorderStyleSingle
                End With
            End With
        Next y
    Next x
    
    GridEventsEnabled = True
End Sub
TinMan
  • 6,624
  • 2
  • 10
  • 20