我有一个包含许多文本框的用户表单。每当这些文本框的值发生变化时,我需要通过调用子例程AutoCalc()基于文本框值重新计算我的最终结果值。
我大约有25个文本框,我不想为每个文本框单独添加Change()事件来调用所述子例程。有什么最快和有效的方法可以在某个值更改时调用AutoCalc()?
我有一个包含许多文本框的用户表单。每当这些文本框的值发生变化时,我需要通过调用子例程AutoCalc()基于文本框值重新计算我的最终结果值。
我大约有25个文本框,我不想为每个文本框单独添加Change()事件来调用所述子例程。有什么最快和有效的方法可以在某个值更改时调用AutoCalc()?
这可以通过使用类模块来实现。在接下来的示例中,我将假设您已经有一个带有一些文本框的用户窗体。
首先,在您的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)我认为创建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
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
看一下这个,了解如何创建一个类来响应任何文本框的更改。该示例是针对按钮的,但可以进行修改。然而,请注意,文本框控件没有退出事件(该事件实际上是用户窗体的一部分),因此您确实需要使用更改事件。
Private WithEvents MyTextBox As MSForms.TextBox
Public Property Set** Control(tb As MSForms.TextBox)
Set MyTextBox = tb
End Property
WithEvents MyTextBox As MSForms.Control
(即从文本框向通用控件降级),您应该可以访问所需的事件。 没有意识到扩展类也不继承事件,非常奇怪。 - Greedo我创建了一种非常简单的方法来向用户窗体添加事件监听器。此外,它还添加了像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
所以前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