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

时间:2010-06-10 12:45:57

标签: events vba controls

我想使用VBA在Excel中在运行时添加一个Control和一个关联的事件,但我不知道如何添加事件。

我尝试了下面的代码,并且在我的userform中正确创建了Button,但是应该显示hello消息的关联click事件无效。

欢迎任何建议/更正。

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

6 个答案:

答案 0 :(得分:17)

在运行时添加按钮然后添加事件的代码真的很简单,因为很难找到..我可以这么说因为我花了更多的时间在这个困惑上并且比任何事情都更加烦躁否则我曾编程..

创建Userform并输入以下代码:

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

现在你需要为你的项目代码添加一个类模块。请记住它的类模块而不是Module.And输入以下简单代码(在我的例子中类名是Class2) -


Public WithEvents butEvents As MSForms.CommandButton

Private Sub butEvents_click()

    MsgBox "Hi Shrey"

End Sub

多数民众赞成。现在运行它

答案 1 :(得分:4)

试试这个:

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的一些很好的信息。

答案 2 :(得分:4)

DaveShaw,这个代码男人的thx!

我已将它用于togglebutton数组(将一个名为trainer.jpg的'thumbnail-size'图片放在与excel文件相同的文件夹中,其中包含一张图片的togglebutton)。在“click”事件中,调用者也可用(通过对象名称作为字符串)

表格形式:

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

答案 3 :(得分:2)

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

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

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 :(得分:1)

我认为代码需要添加到Userform,而不是按钮本身。

类似

With UserForm1.CodeModule
  'Insert code here
End With

代替您的With ThisWorkbook

答案 5 :(得分:0)

一种简单的方法:

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

现在显示表单,然后单击按钮