如何使用 VBA 将事件添加到运行时在 Excel 中创建的控件

Posted 2023-02-22

【中文标题】如何使用 VBA 将事件添加到运行时在 Excel 中创建的控件

【英文标题】：How to add events to Controls created at runtime in Excel with VBA

【发布时间】：2011-03-02 03:52:35

【问题描述】：

我想在运行时使用 VBA 在 Excel 中添加控件和关联事件，但我不知道如何添加事件。

我尝试了下面的代码，并且在我的用户表单中正确创建了按钮，但是应该显示 hello 消息的关联点击事件不起作用。

欢迎任何建议/更正。

Dim Butn As CommandButton
Set Butn = UserForm1.Controls.Add("Forms.CommandButton.1")
With Butn
    .Name = "CommandButton1"
    .Caption = "Click me to get the Hello Message"
    .Width = 100
    .Top = 10
End With

With ThisWorkbook.VBProject.VBComponents("UserForm1.CommandButton1").CodeModule
    Line = .CountOfLines
    .InsertLines Line + 1, "Sub CommandButton1_Click()"
    .InsertLines Line + 2, "MsgBox ""Hello!"""
    .InsertLines Line + 3, "End Sub"
End With
UserForm1.Show

【问题讨论】：

查看this answer，快速了解在 VBA 中使用运行时挂钩事件。

设计精美的问题。谢谢，有完全相同的疑问

【参考方案1】：

在运行时添加按钮然后添加事件的代码真的很简单，很难找到。我可以这么说是因为我在这种困惑上花费了更多的时间，并且比我编程过的任何其他事情都更加烦躁。

创建一个用户表单并输入以下代码：

Option Explicit


Dim ButArray() As New Class2

Private Sub UserForm_Initialize()
    Dim ctlbut As MSForms.CommandButton
    
    Dim butTop As Long, i As Long

    '~~> Decide on the .Top for the 1st TextBox
    butTop = 30

    For i = 1 To 10
        Set ctlbut = Me.Controls.Add("Forms.CommandButton.1", "butTest" & i)

        '~~> Define the TextBox .Top and the .Left property here
        ctlbut.Top = butTop: ctlbut.Left = 50
        ctlbut.Caption = Cells(i, 7).Value
        '~~> Increment the .Top for the next TextBox
        butTop = butTop + 20

        ReDim Preserve ButArray(1 To i)
        Set ButArray(i).butEvents = ctlbut
    Next
End Sub

---

现在您需要在项目代码中添加一个类模块。请记住它是类模块；不是模块。并输入以下简单代码（在我的例子中，类名是 Class2）。

---

Public WithEvents butEvents As MSForms.CommandButton

Private Sub butEvents_click()

    MsgBox "Hi Shrey"

End Sub

---

就是这样。现在运行它！

【讨论】：

很好的答案！为其他类型的表单轻松修改您的示例！

我似乎无法让 Me.Controls.Add(...) 使用 .mdb 文件在 Access 2010 Professional 中工作。我可以添加Microsoft Forms 2.0 Object Library，但是在Acc2010 中没有Microsoft Access Class Object 表单的控件（或控件或表单）对象的Add 方法，该对象绑定到Me 对象。我相信我必须改用CreateControl，但我仍在努力解决细节问题。

我想补充一点，如果您使用 ActiveX 控件并通过currCtrl = sheet)"mysheet").OLEObjects.Item(i) 调用它们，您必须将它们添加到... = currCtrl.Object 的array 或collection，如here 所述.

【参考方案2】：

一个简单的方法：

1 - 插入一个类模块并编写以下代码：

Public WithEvents ChkEvents As MSForms.CommandButton
Private Sub ChkEvents_click()
MsgBox ("Click Event")
End Sub

2 - 插入用户表单并编写以下代码：

Dim Chk As New Clase1
Private Sub UserForm_Initialize()
Dim NewCheck As MSForms.CommandButton
Set NewCheck = Me.Controls.Add("Forms.CommandButton.1")
NewCheck.Caption = "Prueba"
Set Chk.ChkEvents = NewCheck
End Sub

现在显示表单并点击按钮

【参考方案3】：

这是我在不使用类的情况下添加命令按钮和代码的解决方案 它添加了一个引用以允许访问 vbide 添加按钮

然后编写一个函数来处理工作表中的点击事件

Sub AddButton()
Call addref
Set rng = DestSh.Range("B" & x + 3)
'Set btn = DestSh.Buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Left:=rng.Left, Top:=rng.Top, Height:=rng.Height * 3, Width:=rng.Width * 3)
DoEvents
With myButton
     '.Placement = XlPlacement.xlFreeFloating
     .Object.Caption = "Export"
     .Name = "BtnExport"

     .Object.PicturePosition = 1
     .Object.Font.Size = 14
   End With
   Stop
   myButton.Object.Picture = LoadPicture("F:\Finalised reports\Templates\Macros\evolution48.bmp")

Call CreateButtonEvent

End Sub

Sub addref()
On Error Resume Next
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"

End Sub


    Private Sub CreateButtonEvent()
On Error GoTo errtrap

    Dim oXl As Application: Set oXl = Application
    oXl.EnableEvents = False
    oXl.DisplayAlerts = False
    oXl.ScreenUpdating = False
    oXl.VBE.MainWindow.Visible = False

    Dim oWs As Worksheet
    Dim oVBproj As VBIDE.VBProject
    Dim oVBcomp As VBIDE.VBComponent
    Dim oVBmod As VBIDE.CodeModule '
    Dim lLine As Single
    Const QUOTE As String = """"

    Set oWs = Sheets("Contingency")
    Set oVBproj = ThisWorkbook.VBProject
    Set oVBcomp = oVBproj.VBComponents(oWs.CodeName)
    Set oVBmod = oVBcomp.CodeModule

    With oVBmod
        lLine = .CreateEventProc("Click", "BtnExport") + 1
        .InsertLines lLine, "Call CSVFile"
    End With

    oXl.EnableEvents = True
    oXl.DisplayAlerts = True
Exit Sub
errtrap:


End Sub

【参考方案4】：

DaveShaw，感谢这个代码人！

我已将它用于切换按钮数组（将名为 trainer.jpg 的“缩略图大小”图片与包含图片的切换按钮的 excel 文件放在同一文件夹中）。在“点击”事件中，调用者也可用（通过对象名称作为字符串）

形式：

Dim CreateTrainerToggleButtonArray() As New ToggleButtonClass 

Private Sub CreateTrainerToggleButton(top As Integer, id As Integer)

Dim pathToPicture As String
pathToPicture = ThisWorkbook.Path & "\trainer.jpg"
Dim idString As String
idString = "TrainerToggleButton" & id

Dim cCont As MSForms.ToggleButton
Set cCont = Me.Controls.Add _
   ("Forms.ToggleButton.1")

With cCont
   .Name = idString
   .Width = 20
   .Height = 20
   .Left = 6
   .top = top
   .picture = LoadPicture(pathToPicture)
   End With

   ReDim Preserve CreateTrainerToggleButtonArray(1 To id)
   Set CreateTrainerToggleButtonArray(id).ToggleButtonEvents = cCont
   CreateTrainerToggleButtonArray(id).ObjectName = idString

   End Sub

还有一个类“ToggleButtonClass”

  Public WithEvents ToggleButtonEvents As MSForms.ToggleButton
  Public ObjectName As String


  Private Sub ToggleButtonEvents_click()
  MsgBox "DaveShaw is the man... <3 from your friend: " & ObjectName
  End Sub

现在只是来自 UserForm_Initialize 的简单调用

 Private Sub UserForm_Initialize()
   Dim index As Integer
   For index = 1 To 10
     Call CreateTrainerToggleButton(100 + (25 * index), index)
   Next index
 End Sub

【参考方案5】：

试试这个：

Sub AddButtonAndShow()

    Dim Butn As CommandButton
    Dim Line As Long
    Dim objForm As Object

    Set objForm = ThisWorkbook.VBProject.VBComponents("UserForm1")

    Set Butn = objForm.Designer.Controls.Add("Forms.CommandButton.1")
    With Butn
        .Name = "CommandButton1"
        .Caption = "Click me to get the Hello Message"
        .Width = 100
        .Top = 10
    End With

    With objForm.CodeModule
        Line = .CountOfLines
        .InsertLines Line + 1, "Sub CommandButton1_Click()"
        .InsertLines Line + 2, "MsgBox ""Hello!"""
        .InsertLines Line + 3, "End Sub"
    End With

    VBA.UserForms.Add(objForm.Name).Show

End Sub

这会永久修改 UserForm1（假设您保存了工作簿）。如果你想要一个临时的用户表单，那么添加一个新的用户表单而不是将其设置为 UserForm1。完成后，您可以删除该表单。

Chip Pearson 有一些关于 VBE 编码的重要信息。

【参考方案6】：

我认为代码需要添加到用户窗体，而不是按钮本身。

类似

With UserForm1.CodeModule
  'Insert code here
End With

代替你的With ThisWorkbook