我正在尝试创建一个可以在Access中处理多个控制事件的类。这是为了节省输入多行相同代码的重复次数。
我已经按照下一页上的答案进行了操作,但进行了一些调整以将其定制为Access比rahter而不是Excel。
How to assign a common procedure for multiple buttons?
我的班级代码如下:
Option Compare Database
Public WithEvents ct As Access.CommandButton 'Changed object type to something recognised by Access
Public Sub ct_Click()
MsgBox ct.Name & " clicked!"
End Sub
我的表格代码如下:
Option Compare Database
Private listenerCollection As New Collection
Private Sub Form_Load()
Dim ctItem
Dim listener As clListener
For Each ctItem In Me.Controls
If ctItem.ControlType = acCommandButton Then 'Changed to test whether control is a Command Button
Set listener = New clListener
Set listener.ct = ctItem
listenerCollection.Add listener
End If
Next
End Sub
我注意到我已经对(工作)Excel代码进行了更改。我认为问题来自Class中的对象声明。注意:在此过程中不会抛出任何错误;它根本不会触发事件。
提前致谢!
编辑:
我已经将问题缩小到没有[事件程序]'在' On Click'事件。如果我手动添加它,Class将按预期工作。显然,我不想手动添加这些 - 它会使对象失败。有什么想法我会怎么做?
答案 0 :(得分:2)
在OnLoad事件中,您可以添加此行
Dim ctItem
Dim listener As clListener
For Each ctItem In Me.Controls
If ctItem.ControlType = acCommandButton Then 'Changed to test whether control is a Command Button
Set listener = New clListener
Set listener.ct = ctItem
listener.ct.OnClick = "[Event Procedure]" '<------- Assigned the event handler
listenerCollection.Add listener
End If
Next
虽然我不确定这是否更少的代码不仅仅是双击设计器中的OnClick并粘贴方法调用。无论如何都很酷。
修改强> 你可以像这样改变你的课程
Public WithEvents ct As Access.CommandButton 'Changed object type to something recognised by Access
Public Function AddControl(ctrl as Access.CommandButton) as Access.CommandButton
set ct = ctrl
ct.OnClick = "[Event Procedure]"
Set AddControl = ct
End Function
Public Sub ct_Click()
MsgBox ct.Name & " clicked!"
End Sub
然后在你的表单中你可以添加像这样的ct
For Each ctItem In Me.Controls
If ctItem.ControlType = acCommandButton Then 'Changed to test whether control is a Command Button
Set listener = New clListener
listener.AddControl ctItem
listenerCollection.Add listener
End If
Next
现在,在类中添加了事件处理程序。
答案 1 :(得分:0)
使用类模块处理Access Form Controls输入的通用方法:
此代码旨在处理在弹出窗口中编写的应用程序。主窗体包含一个选项卡控件,其中每个选项卡包含自己的子窗体到链接子表或独立表。使用或不使用制表符控件不应对类模块处理产生任何影响。
可以修剪代码以满足您的应用需求。例如,可以从类模块中删除一个未使用的控件。同样,可以通过使用TypeName(Ctl)语句来过滤添加到集合的控件,从而选择控件集合子例程。
在名为clsMultipleControls的类模块中输入以下代码。
Option Compare Database
Option Explicit
Private m_PassedControl As Control
Private WithEvents atch As Attachment
Private WithEvents bfrm As BoundObjectFrame
Private WithEvents chk As CheckBox
Private WithEvents cbo As ComboBox
Private WithEvents btn As CommandButton
Private WithEvents cctl As CustomControl
Private WithEvents img As Image
Private WithEvents lbl As Label
Private WithEvents lin As Line
Private WithEvents Lst As ListBox
Private WithEvents frm As ObjectFrame
Private WithEvents optb As OptionButton
Private WithEvents optg As OptionGroup
Private WithEvents pg As Page
Private WithEvents pgb As PageBreak
Private WithEvents Rec As Rectangle
Private WithEvents sfm As SubForm
Private WithEvents tctl As TabControl
Private WithEvents txt As TextBox
Private WithEvents tgl As ToggleButton
Property Set ctl(PassedControl As Control)
Set m_PassedControl = PassedControl
Select Case TypeName(PassedControl)
Case "Attachment"
Set atch = PassedControl
Case "BoundObjectFrame"
Set bfrm = PassedControl
Case "CheckBox"
Set chk = PassedControl
Case "ComboBox"
Set cbo = PassedControl
Case "CommandButton"
Set btn = PassedControl
Case "CustomControl"
Set cctl = PassedControl
Case "Image"
Set img = PassedControl
Case "Label"
Set lbl = PassedControl
Case "Line"
Set lin = PassedControl
Case "ListBox"
Set Lst = PassedControl
Case "ObjectFrame"
Set frm = PassedControl
Case "OptionButton"
Set optb = PassedControl
Case "OptionGroup"
Set optg = PassedControl
Case "Page"
Set pg = PassedControl
Case "PageBreak"
Set pgb = PassedControl
Case "Rectangle"
Set Rec = PassedControl
Case "SubForm"
Set sfm = PassedControl
Case "TabControl"
Set tctl = PassedControl
Case "TextBox"
Set txt = PassedControl
Case "ToggleButton"
Set tgl = PassedControl
End Select
End Property
在主窗体模块的顶部放置以下代码。
Public collControls As Collection
Public cMultipleControls As clsMultipleControls
在主窗体的Load事件中放置以下代码。
GetCollection Me
在主窗体代码的底部放置以下递归公共子例程:
Public Sub GetCollection(frm As Form)
Dim ctl As Control
On Error Resume Next
Set collControls = collControls
On Error GoTo 0
If collControls Is Nothing Then
Set collControls = New Collection
End If
For Each ctl In frm.Controls
If ctl.ControlType = acSubform Then
GetCollection ctl.Form
Else
Set cMultipleControls = New clsMultipleControls
Set cMultipleControls.ctl = ctl
collControls.Add cMultipleControls
End If
Next ctl
end sub
我建议给表单中的每个控件及其子表单一个唯一的名称,这样您就可以根据控件名称轻松利用Select语句来实现每个类模块事件中的处理控制。例如,每个文本框更改事件将发送到类模块中的txt_change事件,您可以在select语句中使用m_PassedControl.name属性来指示将在传递的控件上执行哪些代码。
如果您有多个控件将接收相同的帖子条目处理,则select事件非常有用。
我使用Main Form Load事件而不是Activate事件,因为弹出窗体(及其子窗体)不会触发Activate或Deactivate事件。
如果您需要进行一些冗长的处理,也可以将m_PassedControl传递给常规模块中的子例程。
不幸的是,除非您实际在VBA模块中设置了事件,否则Access不会自动触发VBA事件。因此,如果要使用文本框更改事件,则必须确保在适用的vba模块中实际设置了文本框更改事件。您不需要向事件添加任何代码,但空事件必须存在,否则事件及其类模块等效项将不会触发。如果有人知道为此工作,我很高兴听到它。
我在http://yoursumbuddy.com/userform-event-class-multiple-control-types/的Excel用户表单代码示例中找到了这个基本的类模块结构。这是一个灵活的结构。我创建了使用Excel用户表单的版本,带有activex控件的Excel工作表,现在用于Access表单。
后续注意:以上代码适用于64位Windows 10上的64位Access 2013.但是当您尝试关闭主窗体时,它在64位Windows 7上的64位Access 2013上失败。解决方案是将以下代码从主窗体移动到VBA模块。
Public collControls As Collection
Public cMultipleControls As clsMultipleControls