Excel UserForm 动态 TextBox 控件退出事件答案

【问题标题】：Excel UserForm dynamic TextBox control exit eventsExcel UserForm 动态 TextBox 控件退出事件
【发布时间】：2019-09-08 07:35:01
【问题描述】：

更新：在对象浏览器中的进一步研究...看来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 属性，但我无法访问该信息来确定要处理哪个标签。

这个类技术改编自this post，和this post，捕获了变化事件。

类 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

【问题讨论】：

在你的类中 MyTextBox 是关联的文本框，而不是 Me（那将是类本身的实例）
@TimWilliams 我也试过了——同样的错误。似乎MSForms.TextBox 既没有实现.Name 属性，也没有实现_Exit 事件——只有_Change 事件。有没有办法确定是哪个特定的TextBox 生成了事件？
如果您无法从 MyTextBox 中获取名称，那么您可以将其存储为您班级中的另一个属性/字段...

标签： excel vba events userform

【解决方案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 有足够的烟雾和镜子来成功编译上述内容，但是，基本上，您正在查看 The Matrix 中的一个小故障（Rubberduck 的解析器与 MSForms 控件有类似的“nope”问题）：没有任何明显的方法可以得到VBA 将动态控件对象绑定到其MSForms.Control 事件。

【讨论】：

@ZephyrMays 尝试将tb 声明为Object，并仔细检查WithEvents 字段中声明的As 类型......
@ZephyrMays wah 我错过了一些东西...立即窗格：set o = UserForm1.Controls.Add("Forms.TextBox.1")，然后是?typeof o is MSForms.Control - 说是的。然而Set thing.Control = o -> 不支持事件。奇怪...
@ZephyrMays 这……很复杂。 Rubberduck 很难弄清楚 MSForms 控制接口是有原因的……似乎 VBA 也很难。这不完全是继承，只是.. 某种涉及在运行时附加接口的 COM hack（表单设计器本质上是运行时）。看起来它正在阻止 VBA 正确绑定事件源，即使在编译时没有问题。你让我在这里被严重的书呆子狙击了。
@ZephyrMays 看起来与MSForms.Control 事件无关。我发现了这个：excelforum.com/excel-programming-vba-macros/… - 看起来他们有一个可下载的解决方案，但我不确定我是否会相信一些随机论坛的随机下载。
这可能行得通。请记住，执行在运行时生成的代码，在项目编译之后，不能使用断点进行调试，使应用程序更容易崩溃，并且需要提升宏安全设置（运行 VBIDE API 的特定权限）。经常保存！

【解决方案2】：

借助 ConnectToConnectionPoint API，您可以捕获每个控件的事件（每个事件，也包括进入和退出）。

看看这里：Trigger Enter field behaviour through class for a control

对于退出它将是

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

【讨论】：