How to add events to Controls created at runtime in Excel with VBA
I would like to add a Control and an associated event at runtime in Excel using VBA but I don't know how to add the events.
I tried the code below and the Button is 开发者_如何学Pythoncorrectly created in my userform but the associated click event that should display the hello message is not working.
Any advice/correction would be welcome.
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
The code for adding a button at runtime and then to add events is truly as simple as it is difficult to find out. I can say that because I have spent more time on this perplexity and got irritated more than in anything else I ever programmed.
Create a Userform and put in the following code:
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
Now you need to add a Class Module to your code for the project. Please remember it's class module, not Standard Module.
The Object butEvents
is the button that was clicked.
Put in the following simple code (in my case the class name is Class2).
Public WithEvents butEvents As MSForms.CommandButton
Private Sub butEvents_click()
MsgBox "Hi Shrey from " & butEvents.Caption
End Sub
That's it. Now run it!
Try this:
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
This permanently modifies UserForm1 (assuming you save your workbook). If you wanted a temporary userform, then add a new userform instead of setting it to UserForm1. You can then delete the form once you're done with it.
Chip Pearson has some great info about coding the VBE.
DaveShaw, thx for this code man!
I have used it for a togglebutton array (put a 'thumbnail-size' picture called trainer.jpg in the same folder as the excel file for a togglebutton with a picture in it). In the 'click' event the invoker is also available (by the object name as a string)
In the form:
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
and a class "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
Now just simple call from 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
This was my solution to add a commandbutton and code without using classes It adds a reference to allow access to vbide Adds the button
Then writes a function to handle the click event in the worksheet
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
An easy way to do it:
1 - Insert a class module and write this code:
Public WithEvents ChkEvents As MSForms.CommandButton
Private Sub ChkEvents_click()
MsgBox ("Click Event")
End Sub
2 - Insert a userform and write this code:
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
Now show the form and click the button
I think the code needs to be added to the Userform, not to the button itself.
So something like
With UserForm1.CodeModule
'Insert code here
End With
In place of your With ThisWorkbook
精彩评论