Help with class change event

Wayner84

New Member
Joined
Apr 7, 2021
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
Ive successfully used Jafar's code for the capturing of change events of dynamic textboxes. See Here
But i cant seem to get the chnage event to run on the textboxes.
Here is my code for my userform
VBA Code:
Private Sub UserForm_Activate()
    


'DEBUGGING
addLabel



End Sub


Private Sub UserForm_AddControl(ByVal Control As MsForms.Control)

    Static oCol As Collection
    Dim oTextBoxEvents As CTextBoxEvents
    
    'hook the added textboxes events.
    If TypeOf Control Is MsForms.TextBox Then
        Set oTextBoxEvents = New CTextBoxEvents
        oTextBoxEvents.SetControlEvents(Control) = True
        If oCol Is Nothing Then
            Set oCol = New Collection
        End If
        oCol.Add oTextBoxEvents
    End If

End Sub

Here is my 'addlabel' code
Code:
Public meas As Long
Sub addLabel()
Set PD = Sheets("ProgramData")

Dim theLabel As Object
Dim labelCounter As Long

col = 3

'DEBUGGING



Set Title = UserForm1.Controls.Add("Forms.Label.1", "Part", True)
With Title
    .Caption = PD.Cells(meas, 1)
    .Left = 10
    .Top = 10
    .FontSize = 18
End With

For labelCounter = 1 To PD.Cells(meas, 2)
    Set theLabel = UserForm1.Controls.Add("Forms.Label.1", "labdim" & labelCounter, True)
    With theLabel
        .Caption = Format(PD.Cells(meas, col), "0.00")
        .Left = 10
        .Width = 50
        .Top = 34 + 20 * labelCounter
        .Height = 20
    End With
col = col + 3
Next


col = 5
For labelCounter = 1 To PD.Cells(meas, 2)
    Set theLabel = UserForm1.Controls.Add("Forms.Label.1", "labdimlow" & labelCounter, True)
    With theLabel
        .Caption = Format(PD.Cells(meas, col), "0.00")
        .Left = 50
        .Width = 50
        .Top = 34 + 20 * labelCounter
        .Height = 20
    End With
col = col + 3
Next



For labelCounter = 1 To PD.Cells(meas, 2)
    Set theLabel = UserForm1.Controls.Add("Forms.TextBox.1", "txtdim" & labelCounter, True)
    With theLabel

        .Left = 75
        .Width = 70
        .Top = 30 + 20 * labelCounter
        .Height = 17
    End With
Next


col = 4
For labelCounter = 1 To PD.Cells(meas, 2)
    Set theLabel = UserForm1.Controls.Add("Forms.Label.1", "labdimup" & labelCounter, True)
    With theLabel
        .Caption = Format(PD.Cells(meas, col), "0.00")
        .Left = 150
        .Width = 50
        .Top = 34 + 20 * labelCounter
        .Height = 20
    End With
col = col + 3
Next
UserForm1.Show 0
End Sub

Public Sub Tester()
Dim CTRL
Dim i As Long

For Each CTRL In UserForm1.Controls
i = i + 1
Cells(i, 1).Value = CTRL.Name
Next CTRL

End Sub


Here is my Class code
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
    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
    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
    Debug.Print "[BEFORE_UPDATE EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value

End Sub

Public Sub AfterUpdate()

    'Attribute AfterUpdate.VB_UserMemId = &H80018200
    Debug.Print "[AFTER_UPDATE EVENT] " & oTextBox.Name & vbTab & "Value: " & vbTab & oTextBox.Value

End Sub

My textboxes arent named TextBox1, TextBox2... etc they are named txtdim1, txtdim2, etc..

Any help would be appreciated
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
You're not calling the UserForm_AddControl routine so the newly added controls are not hooked-up with instances of the class.
 
Upvote 0
You're not calling the UserForm_AddControl routine so the newly added controls are not hooked-up with instances of the class.
That makes a lot of sense! Thank you
Can i call this within my loops or do i need to create the controls inside the 'UserForm_AddControl' sub?
 
Upvote 0
Forget what I said, userform_AddControl is of course an event which is called as soon as you add a control!
 
Upvote 0
Behind your userform use this code:
Code:
Option Explicit

Dim oCol As Collection

Private Sub UserForm_Activate()

    Dim oCtrl As Control, i As Integer, lTop As Long
    
    'add 4 textboxes at runtime
    lTop = 20
    For i = 1 To 4
        Set oCtrl = Me.Controls.Add("Forms.TextBox.1", "TextBox" & i, True)
       
        With oCtrl
            oCtrl.Top = lTop: oCtrl.Left = 75
        End With
        lTop = lTop + 30
    Next i

End Sub

Private Sub UserForm_AddControl(ByVal Control As msforms.Control)
    Dim oTextBoxEvents As CTextBoxEvents
    
    'hook the added textboxes events.
    If TypeOf Control Is msforms.TextBox Then
        Set oTextBoxEvents = New CTextBoxEvents
        oTextBoxEvents.SetControlEvents Control
        If oCol Is Nothing Then
            Set oCol = New Collection
        End If
        oCol.Add oTextBoxEvents
    End If

End Sub

Private Sub UserForm_Terminate()
    Set oCol = Nothing
End Sub
and in the class module:
Code:
Option Explicit

Private WithEvents txt As msforms.TextBox

Public Sub SetControlEvents(ByVal TextBox As Object)
    Set txt = TextBox
End Sub

Private Sub txt_Change()
    MsgBox "Changed '" & txt.Name & "' to: " & txt.Value
End Sub
 
Upvote 0
Solution
Just deleted my post as i got it working in the end! Works perfectly thanks so much! just to confirm, replacing the creation of the 4 textboxes with my addlabel sub wont cause any issues will it? And also just a general question, do i use class modules to handle dynamically created controls or am i understanding it wrong?

Thanks again man i really appreciate it :)
 
Upvote 0
The class modules are necessary as soon as you need an event of a runtime-added control to work. If you do not need any event of runtime-added controls, a class module is not needed.
 
Upvote 0

Forum statistics

Threads
1,223,880
Messages
6,175,155
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top