我尝试在下面的链接中调整解决方案，使文本框的集合仅允许数字。我没有得到任何错误，但课程并不适用于文本框。
Excel VBA Userform - Execute Sub when something changes
课程模块
Public WithEvents TextGroup As MSForms.TextBox
Public Property Set Control(tb As MSForms.TextBox)
Set TextGroup = tb
End Property
Private Sub TextGroup_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub
用户窗体
Dim tbCollection As Collection
Private Sub UserForm_Initialize()
Dim obj As clsTextBox
Dim ctrl As Control
Set tbCollection = New Collection
tbCollection.Add Me.tbAC
tbCollection.Add Me.tbCR
tbCollection.Add Me.tbHP
For Each ctrl In tbCollection
Set obj = New clsTextBox
Set obj.Control = ctrl
Next
End Sub
答案 0 :(得分：1)
您需要将obj对象放在集合中，而不是控件本身
未测试：
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
答案 1 :(得分：0)
您可以收听TextBox退出事件吗？类似于普通TextBox事件如何工作？例如
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Update a certain label based on the value of the TextBox
End Sub
以下内容未捕获退出事件。而且，虽然我可以在本地窗口中看到为MyTextBox生成事件的TextBox的.Name属性，但我无法访问该信息来确定要对哪个标签进行操作。
该类技术确实捕获了一些更改事件。
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
我有一系列动态创建的需要监听器的控件。代码如下：
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