Excel UserForm动态TextBox控件退出事件

Question

更新：在对象浏览器中进行进一步研究后，似乎MSForms.TextBox既不实现.Name属性也不实现_Exit事件-仅实现_Change事件。 有没有办法确定哪个特定的TextBox生成了更改事件？

或者可以通过此技术使用MSForms.Control吗？ Control对象实现.Name属性和_Exit事件。

---

您可以听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 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

        ' Correct for border size calculations bug in Excel 2016
        Me.Height = 249.75
        Me.Width = 350.25

        acftNumber = Range("aircraft").Count 'Unknown value from 3 to 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

Answer 1

MSForms.Control定义Enter和Exit事件：如果需要处理TextBox.Change ，则需要两个WithEvents变量：

Private WithEvents TextBoxEvents As MSForms.TextBox
Private WithEvents ControlEvents As MSForms.Control

Public Property Set Control(ByVal tb As Object)
    Set TextBoxEvents = tb
    Set ControlEvents = tb
End Property

MSForms.Control也是一个接口，通过它可以访问诸如Name ， Top ， Left ， Visible等属性。

提示：切勿手动键入事件处理程序过程签名。 从代码窗格左上角的下拉菜单中选择源接口，然后从右上角的下拉菜单中选择一个要处理的事件。 让VBE生成具有正确签名的成员。 如果您正在处理程序过程中，并且左上角的下拉菜单中显示“（常规）”，则说明您不在事件处理程序中。

---

编辑

虽然上面的代码可以很好地编译，并且MSForms.Control接口确实公开了我们要处理的事件...

?TypeOf tb Is MSForms.Control
True
?TypeOf tb Is MSForms.TextBox
True

...幕后有一些COM骇客活动； VBA有足够的烟雾和镜像可以成功地编译上述内容，但是，基本上，您正在看《黑客帝国》中的故障（Rubberduck的解析器在MSForms控件中存在类似的“ nope”问题）：没有任何明显的方法可以获取VBA将动态控件对象绑定到其MSForms.Control事件。

Answer 2

借助ConnectToConnectionPoint API，您可以捕获每个控件的事件（每个事件，以及Enter和Exit）。

在这里看看： 触发通过控件的类输入字段行为

对于退出它将是

Public Sub myExit(ByVal Cancel As MSForms.ReturnBoolean)
Attribute myExit.VB_UserMemId = -2147384829
'code
End Sub