I tried adapting the solution in the link below to make a collection of text boxes allow numbers only. I get no error but the class just doesn\'t apply to the textboxes.
<Can you listen for a TextBox exit event? Similarly to how a normal TextBox event would work? E.g.
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Update a certain label based on the value of the TextBox
End Sub
The following doesn't catch the exit event. Moreover, while I can see the .Name property of the TextBox which generated the event for MyTextBox in the locals window, I cannot access that info to determine which label to act on.
This class technique does catch some of the change events.
Class clsTextBox:
Private WithEvents MyTextBox As MSForms.TextBox
Public Property Set Control(tb As MSForms.TextBox)
Set MyTextBox = tb
End Property
' Want to handle this event, but it's not caught when exiting the TextBox control
Private Sub MyTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Debug.Print me.Control.name
'Update a certain label based on the value of the TextBox
Stop
End Sub
' Catching this event but can't identify the control which triggered it
Private Sub MyTextBox_Change()
Debug.Print MyTextBox.Value ' <--- This prints the correct value
Debug.Print Me.Control.Name ' <--- ERROR here on any variation of Me or MyTextBox
'Update a certain label based on the value of the TextBox
Stop
End Sub
I have a series of dynamically created controls which need listeners. Code follows:
Option Explicit
Dim tbCollection As Collection
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Stop
End Sub
Private Sub UserForm_Initialize()
Dim ctrl As MSForms.Control
Dim obj As clsTextBox
Dim acftNumber As Long
Dim mPage As MSForms.MultiPage ' Control
Dim lbl_acftName As MSForms.Label
Dim lbl_currentHrs As MSForms.Label
Dim lbl_hrsDUE As MSForms.Label
Dim lbl_dateXFRIn As MSForms.Label
Dim lbl_dateXFROut As MSForms.Label
Dim lbl_hrsOnXFROut As MSForms.Label
Dim txb_currentHrs As MSForms.TextBox
Dim txb_hrsDUE As MSForms.TextBox
Dim txb_dateXFRIn As MSForms.TextBox
Dim txb_dateXFROut As MSForms.TextBox
Dim txb_hrsOnXFROut As MSForms.TextBox
Dim i As Double
Dim pgName As String
Dim acftName As String
'Dim ctrl As MSForms.Control
' Correct for border size calculations bug in Excel 2016
Me.Height = 249.75
Me.Width = 350.25
acftNumber = Range("aircraft").Count ' Some unknown value betweet 3 and 10
Set mPage = Me.multipage_file_week 'set Multipage variable
For i = 1 To acftNumber
'set name/title for new page
pgName = "pg_acft_" & i
acftName = Range("aircraft").Cells(i, 1).Value
'mPage.Pages.Add pgName, pgTitle
With mPage 'add acft tab
' add the aircraft page to the multipage
.Pages.Add pgName, acftName
' Aircraft Name Label
Set lbl_acftName = .Pages(i).Controls.Add("Forms.Label.1", "lbl_acftName_" & i, True)
With lbl_acftName
.Caption = acftName
.Font = "Arial"
.Font.Size = 12
.Font.Bold = True
.Left = 10
.Width = 55
.Top = 0
End With
' Current Hours Label and TextBox
Set lbl_currentHrs = .Pages(i).Controls.Add("Forms.Label.1", "lbl_currentHrs_" & i, True)
With lbl_currentHrs
.Caption = "Current Asset Hours:"
.TextAlign = fmTextAlignRight
.Font = "Arial"
.Font.Size = 10
.Font.Bold = False
.Left = 20
.Width = 120
.Top = 25
End With
Set txb_currentHrs = .Pages(i).Controls.Add("Forms.TextBox.1", "txb_currentHrs_" & i, True)
With txb_currentHrs
.Value = "16004.5"
.Text = "16004.5"
.Font = "Arial"
.Font.Size = 10
.Font.Bold = False
.Left = 150
.Width = 70
.Top = 25
End With
' Hours DUE Label and TextBox
Set lbl_hrsDUE = .Pages(i).Controls.Add("Forms.Label.1", "lbl_hrsDUE_" & i, True)
With lbl_hrsDUE
.Caption = "Hours next HMC DUE:"
.TextAlign = fmTextAlignRight
.Font = "Arial"
.Font.Size = 10
.Font.Bold = False
.Left = 20
.Width = 120
.Top = 50
End With
Set txb_hrsDUE = .Pages(i).Controls.Add("Forms.TextBox.1", "txb_hrsDUE_" & i, True)
With txb_hrsDUE
.Value = "16004.5"
.Text = "16004.5"
.Font = "Arial"
.Font.Size = 10
.Font.Bold = False
.Left = 150
.Width = 70
.Top = 50
End With
' Date XFR In Label and TextBox
Set lbl_dateXFRIn = .Pages(i).Controls.Add("Forms.Label.1", "lbl_dateXFRIn_" & i, True)
With lbl_dateXFRIn
.Caption = "Estimated arrival date:"
.TextAlign = fmTextAlignRight
.Font = "Arial"
.Font.Size = 10
.Font.Bold = False
.Left = 20
.Width = 120
.Top = 75
End With
Set txb_dateXFRIn = .Pages(i).Controls.Add("Forms.TextBox.1", "txb_hrsDUE_" & i, True)
With txb_dateXFRIn
.Value = "4/16/2019"
.Text = "4/16/2019"
.Font = "Arial"
.Font.Size = 10
.Font.Bold = False
.Left = 150
.Width = 70
.Top = 75
End With
' Date XFR Out Label and TextBox
Set lbl_dateXFROut = .Pages(i).Controls.Add("Forms.Label.1", "lbl_dateXFROut_" & i, True)
With lbl_dateXFROut
.Caption = "Estimated departure date:"
.TextAlign = fmTextAlignRight
.Font = "Arial"
.Font.Size = 10
.Font.Bold = False
.Left = 20
.Width = 120
.Top = 100
End With
Set txb_dateXFROut = .Pages(i).Controls.Add("Forms.TextBox.1", "txb_hrsDUE_" & i, True)
With txb_dateXFROut
.Value = "4/16/2019"
.Text = "4/16/2019"
.Font = "Arial"
.Font.Size = 10
.Font.Bold = False
.Left = 150
.Width = 70
.Top = 100
End With
' Hours on XFR Out Label and TextBox
Set lbl_hrsOnXFROut = .Pages(i).Controls.Add("Forms.Label.1", "lbl_hrsOnXFROut_" & i, True)
With lbl_hrsOnXFROut
.Caption = "Desired hours remaining on departure:"
.TextAlign = fmTextAlignLeft
.Font = "Arial"
.Font.Size = 10
.Font.Bold = False
.Left = 20
.Width = 170
.Top = 125
End With
Set txb_hrsOnXFROut = .Pages(i).Controls.Add("Forms.TextBox.1", "txb_hrsDUE_" & i, True)
With txb_hrsOnXFROut
.Value = "35"
.Text = "35"
.Font = "Arial"
.Font.Size = 10
.Font.Bold = False
.Left = 200
.Width = 35
.Top = 125
End With
End With
'Debug
Debug.Print Me.multipage_file_week.Pages(i).Name & ":"
For Each ctrl In Me.multipage_file_week.Pages(i).Controls
Debug.Print " - " & ctrl.Name
Next ctrl
Next i
mPage.Value = 0
Me.Caption = FILE_WEEK_FORM_TITLE
Set tbCollection = New Collection
For Each ctrl In Me.Controls
If TypeOf ctrl Is MSForms.TextBox Then
Set obj = New clsTextBox
Set obj.Control = ctrl
tbCollection.Add obj
End If
Next ctrl
Set obj = Nothing
End Sub
You need to put the obj objects in the collection, not the controls themselves
Untested:
Dim tbCollection As Collection
Private Sub UserForm_Initialize()
Dim obj As clsTextBox
Dim arr
Dim ctrl
Set tbCollection = New Collection
arr = Array(Me.tbAC, Me.tbCR, Me.tbHP) '<< edit: no Set
For Each ctrl in arr
Set obj = New clsTextBox
Set obj.Control = ctrl
tbCollection.Add obj
Next
End Sub