Excel VBA - Creating buttons dynamically with code assigned - excel

Question

I am trying to create some buttons dynamically, and assign code to them.
The following code works
Dim MyR As Range, MyB As OLEObject
Dim MyR_T As Long, MyR_L As Long
Set MyR = Cells(i + 1, 11) 'just an example - you get that from your own script
MyR_T = MyR.Top 'capture positions
MyR_L = MyR.Left '...
'create button
Set MyB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False)
'set main button properties
With MyB
.Name = "MyPrecodedButton" 'important - code must exist ... see below
.Object.Caption = "MyCaption"
.Top = MyR_T
.Left = MyR_L
.Width = 50
.Height = 18
.Placement = xlMoveAndSize
.PrintObject = True 'or false as per your taste
End With
It creates the buttons within my loop. However, I want to assign something to the on click, so I use the following code
Dim MyR As Range, MyB As OLEObject
Dim MyR_T As Long, MyR_L As Long
Set MyR = Cells(i + 1, 11) 'just an example - you get that from your own script
MyR_T = MyR.Top 'capture positions
MyR_L = MyR.Left '...
'create button
Set MyB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False)
'set main button properties
With MyB
.OnAction = "interpHere"
.Name = "MyPrecodedButton" 'important - code must exist ... see below
.Object.Caption = "MyCaption"
.Top = MyR_T
.Left = MyR_L
.Width = 50
.Height = 18
.Placement = xlMoveAndSize
.PrintObject = True 'or false as per your taste
End With
Sub interpHere()
MsgBox "hi"
End Sub
I have basically added .OnAction = "interpHere" but when I run it, I get an error, unable to set the onaction property.
Where am I going wrong?

Answer 1

try this code
Sub CreateButtons()
Dim btn As Button
ActiveSheet.Buttons.Delete
Dim t As Range
For i = 2 To 6 Step 2
Set t = ActiveSheet.Cells(i, 3)
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "interpHere"
.Caption = "Btn " & i
.Name = "Btn" & i
End With
Next i
End Sub
Sub interpHere()
MsgBox "hi"
End Sub