Excel VBA用户窗体 - 当某些内容发生变化时执行子程序

8

我有一个包含许多文本框的用户表单。每当这些文本框的值发生变化时,我需要通过调用子例程AutoCalc()基于文本框值重新计算我的最终结果值。

我大约有25个文本框,我不想为每个文本框单独添加Change()事件来调用所述子例程。有什么最快和有效的方法可以在某个值更改时调用AutoCalc()?

7个回答

16

这可以通过使用类模块来实现。在接下来的示例中,我将假设您已经有一个带有一些文本框的用户窗体。

首先,在您的VBA项目中创建一个类模块(我们称之为clsTextBox - 一定要更改类模块的“名称”属性!)

Private WithEvents MyTextBox As MSForms.TextBox

Public Property Set Control(tb As MSForms.TextBox)
    Set MyTextBox = tb
End Property

Private Sub MyTextBox_Change()
    AutoCalc() //call your AutoCalc sub / function whenever textbox changes
End Sub

现在,在用户表单中添加以下代码:

Dim tbCollection As Collection

Private Sub UserForm_Initialize()
    Dim ctrl As MSForms.Control
    Dim obj As clsTextBox

    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

1
嗨,创建tbCollection的必要性是什么?它有什么作用? - Ashok
1
该集合用于存储和持久化创建的文本框对象。 - Alex P

8

如上所述,使用类是一种处理多个控件的简洁而优雅的好策略,但:

1)我认为创建25个事件并调用一个常用的用户窗体私有程序没有问题,除非控件的数量是动态的。这是“保持简单”的哲学。

2)通常,我认为“更改”事件非常令人不安,因为它在输入每个数字时都会进行重新计算。使用“退出”事件或“更新前”事件更加明智和适度,因为它仅在决定值时进行重新计算。例如,“Google即时搜索”试图返回响应,消耗资源,而用户还没有定义问题。

3)存在验证问题。我同意你可以使用“更改”事件避免错误的按键,但是如果需要验证数据,则无法知道用户是否继续输入或数据是否准备好进行验证。

4)您应该记住,“更改”或“退出”事件并不强制用户通过文本字段,因此在尝试退出表单而不取消时,系统需要重新验证和重新计算。

以下代码对于静态表单非常简单但有效。

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call  AutoCalc(Cancel)
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call  AutoCalc(Cancel)
End Sub
.....
Private Sub TextBox25_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call  AutoCalc(Cancel)
End Sub

Private Function Valid
.....
End Function 

Private Sub AutoCalc(Canc As Variant)
If Not Valid() Then Canc=True
'  Calculation
End Sub

如果你想节省时间,可以创建一个通用的VBA例程来生成与适合掩码的表单中的控件相关的事件代码。这些代码可以在草稿工作表中生成(直接生成代码存在某些Excel版本中的错误),然后复制并粘贴到表单模块中。请注意保留HTML标记。
 Sub GenerateEvent(Form As String, Mask As String, _
   Evento As String, Code As String)
 '  Form - Form name in active workbook
 '  Mark - String piece inside control name
 '  Evento - Event name to form procedure name
 '  Code   - Code line inside event
 Dim F As Object
 Dim I As Integer
 Dim L As Long
 Dim R As Range
 Dim Off As Long
 Set F = ThisWorkbook.VBProject.VBComponents(Form)
 Set R = ActiveCell   ' Destination code
 Off = 0
 For I = 0 To F.Designer.Controls.Count - 1
    If F.Designer.Controls(I).Name Like "*" & Mask & "*" Then
        R.Offset(Off, 0) = "Private Sub " & _
          F.Designer.Controls(I).Name & "_" & Evento & "()"
        R.Offset(Off + 1, 0) = "     " & Code
        R.Offset(Off + 2, 0) = "End Sub"
        Off = Off + 4
    End If
 Next I
 End Sub

 Sub Test()
 Call GenerateEvent("FServCons", "tDt", "Exit", _
    "Call AtuaCalc(Cancel)")
 End Sub

6

看一下这个,了解如何创建一个类来响应任何文本框的更改。该示例是针对按钮的,但可以进行修改。然而,请注意,文本框控件没有退出事件(该事件实际上是用户窗体的一部分),因此您确实需要使用更改事件。


你上面的链接已经失效了。 - Robert Todar
@RobertTodar,谢谢,我找到了那个页面的新地址。它基本上是与Alex P的被接受答案相同的信息。 - Doug Glancy

1
我遇到了类似的问题,我想使用一个通用的例程验证大约48个不同的文本框,类模块方法看起来很有趣(代码行数少得多)。但我不想在每输入一个字符后都进行验证,我只想在更新后检查。如果输入的数据无效,我希望清除文本框并保留在同一个文本框中,这需要在退出例程中使用Cancel = True。经过几个小时的尝试,我的AfterUpdate和Exit事件处理程序从未触发,我发现了原因。
如果您创建以下类:
Private WithEvents MyTextBox As MSForms.TextBox

Public Property Set** Control(tb As MSForms.TextBox)

    Set MyTextBox = tb

End Property

当你进入VBE对象浏览器并选择MyTextBox时,你会发现支持的枚举事件不包括AfterUpdate或Exit。如果你进入用户窗体并使用VBE对象浏览器查看TextBox实例,则可以使用这些事件,但它们似乎是从TextBox所属的控件继承而来的。使用MSForms.TextBox定义新类不包括这些事件。如果你尝试手动定义这些事件处理程序,它们将编译,并且看起来它们可以工作(但实际上不能)。它们不会成为类对象的事件处理程序,而只是出现在VBE对象浏览器下的(General)中的私有子例程,永远不会被执行。似乎创建有效的事件处理程序的唯一方法是在VBE对象浏览器中选择类对象,然后从枚举事件列表中选择所需的事件。
经过多小时的搜索,我未能找到任何参考资料,显示如何在私有类中构建类似的继承模型,以便AfterUpdate和Exit会显示为所创建类的可用事件。因此,对于想要使用AfterUpdate和/或Exit的人来说,上述每个TextBox都有一个单独的事件处理程序的建议可能是唯一可行的方法。

非常有趣的观察 - 我想避免此问题的方法是永远不要手动输入事件处理程序,而是使用编辑器右上角的下拉菜单获取所有可能事件的列表(这样您就不会尝试添加不支持的事件)。至于解决方案,只需声明 WithEvents MyTextBox As MSForms.Control(即从文本框向通用控件降级),您应该可以访问所需的事件。 没有意识到扩展类也不继承事件,非常奇怪。 - Greedo
嗨,你是对的,这个继承模型无法在纯VBA中复制。 - Greedo

0
然而,请注意,文本框控件没有退出事件(该事件实际上是用户窗体的一部分),因此您确实需要使用更改事件。
我很困惑。也许这是在2007年添加的,或者我不理解细微差别。我在TextBox控件上使用Exit事件。当我从控件中切换时,或者单击另一个控件时,它会触发Exit事件。

0

双类模块方法

我创建了一种非常简单的方法来向用户窗体添加事件监听器。此外,它还添加了像MouseOver和MouseOut这样的事件。(用于实现悬停效果)

需要导入的两个类模块可以在我的Github页面VBA Userform Event Listeners中找到。


如何在用户窗体中使用代码

添加我的类模块后,将以下示例代码添加到用户窗体即可轻松入手。

Private WithEvents Emitter As EventListnerEmitter
    
Private Sub UserForm_Activate()
   Set Emitter = New EventListnerEmitter
   Emitter.AddEventListnerAll Me
End Sub

就是这样! 现在你可以开始监听不同的事件了。


主事件监听器

有一个主要的EmittedEvent事件。它传递了事件所在的控件和事件名称。因此,所有事件都通过此事件处理程序。

Private Sub Emitter_EmittedEvent(Control As Object, ByVal EventName As String, EventValue As Variant)
    
    If TypeName(Control) = "Textbox" And EventName = "Change" Then
        'DO WHATEVER
    End If
  
End Sub

单个事件监听器

您还可以仅监听特定事件,例如此处的更改事件。

Private Sub Emitter_Change(Control As Object)

    If TypeName(Control) = "Textbox" Then
          'DO WHATEVER
    End If
    
End Sub

欢迎查看我的Github页面,并提交拉取请求,因为并没有捕获所有事件。

-1

所以前9行是从一个我记不得在哪里的论坛上给我的。但我在此基础上进行了改进,现在我想使用一个命令按钮,在用户更改此子程序中列出的变量时重新计算。

Private Sub txtWorked_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    11 Dim OTRate       As Double
       OTRate = Me.txtHourlyRate * 1.5
    If Me.txtWorked > 40 Then
       Me.txtBasePay.Value = Format(Me.txtHourlyRate.Value * 40, "$#,##0.00")
       Me.txtOvertime = Format((Me.txtWorked - 40) * OTRate, "$#,##0.00")
    Else
       Me.txtOvertime.Value = "0"
       Me.txtBasePay.Value = Format(Me.txtHourlyRate.Value * Me.txtWorked.Value, "$#,##0.00")
    End If
    Dim Gross, W2, MASSTax, FICA, Medi, Total, Depends, Feds As Double
       Gross = CDbl(txtBonus.Value) + CDbl(txtBasePay.Value) +    CDbl(txtOvertime.Value)
       W2 = txtClaim * 19
       Me.txtGrossPay.Value = Format(Gross, "$#,##0.00")
       FICA = Gross * 0.062
       Me.txtFICA.Value = Format(FICA, "$#,##0.00")
       Medi = Gross * 0.0145
       Me.txtMedicare.Value = Format(Medi, "$#,##0.00")
       MASSTax = (Gross - (FICA + Medi) - (W2 + 66)) * 0.0545
    If chkMassTax = True Then
       Me.txtMATax.Value = Format(MASSTax, "$#,##0.00")
    Else: Me.txtMATax.Value = "0.00"
    End If
    If Me.txtClaim.Value = 1 Then
       Depends = 76.8

    ElseIf Me.txtClaim.Value = 2 Then
       Depends = 153.8

    ElseIf Me.txtClaim.Value = 3 Then
       Depends = 230.7
    Else
       Depends = 0
    End If
       If (Gross - Depends) < 765 Then
       Feds = ((((Gross - Depends) - 222) * 0.15) + 17.8)
       Me.txtFedIncome.Value = Format(Feds, "$#,##.00")
    ElseIf (Gross - Depends) > 764 Then
       Feds = ((((Gross - Depends) - 764) * 0.25) + 99.1)
       Me.txtFedIncome.Value = Format(Feds, "$#,##.00")
    Else:
       Feds = 0
    End If
       Total = (txtMATax) + (FICA) + (Medi) + (txtAdditional) + (Feds)
       Me.txtTotal.Value = Format(Total, "$#,##0.00")
       Me.txtNetPay.Value = Format(Gross - Total, "$#,##0.00")

End Sub

Private Sub cmdReCalculate_Click()

End Sub

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接