如何使用具有控件集合的类答案

【问题标题】：How to use a Class with a Collection of Controls如何使用具有控件集合的类
【发布时间】：2019-04-18 09:51:49
【问题描述】：

我尝试调整以下链接中的解决方案，使文本框集合仅允许数字。我没有收到任何错误，但该类不适用于文本框。

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

【问题讨论】：

标签： excel vba

【解决方案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

【讨论】：

我在 Set arr 行收到类型不匹配错误。我尝试将 arr 调暗为 Variant，但仍然出现错误。
对不起，我的错字 - 该作业不需要 Set
谢谢你，效果很好！那么此时使用 Collection 是否有意义？我可能只是循环遍历数组来分配类。
一旦 Initialize 方法结束，您需要类实例保持“活动”状态：全局集合只是对象的存储位置，因此它们不会超出范围。
啊，好吧，我想我明白了。

【解决方案2】：

你能监听 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

【讨论】：