How do I link a button created with VBA with a procedure in another module?

Glory

Glory

Well-known Member
Joined
Mar 16, 2011
Messages
640
Code creates button. How do I link the button with some code?

Code: 
ThisWorkbook.ActiveSheet.OLEObjects.Add ClassType:="Forms.CommandButton.1", _
                                        Height:=32, _
                                        Object:="Update", _
                                        Left:=292, _
                                        Top:=34, _
                                        Width:=102
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
I should clarify, the code I'm using also creates a new sheet, so there's no way to just stick code into the sheet module.

Do I actually need to use VBA to write code into the sheet's module? And call the procedure the same name as the button?
 
Upvote 0
I think you just set the object's .OnAction property to the name of the macro you want it to execute.
 
Upvote 0
Are you trying to pass parameters to the macro?

If not, just setting the .OnAction to the macro's name should work.

If you are, then the entire .OnAction string needs to be wrapped in single quotes, like so:-
Code: 
[SIZE=3].OnAction = [COLOR=red]"[/COLOR]'mymacro 99'[COLOR=red]"[/COLOR][/SIZE]
or:-
Code: 
[SIZE=3].OnAction = [COLOR=red]"[/COLOR]'mymacro [COLOR=magenta]""[/COLOR]fred[COLOR=magenta]""[/COLOR]'[COLOR=red]"[/COLOR][/SIZE]
 
Last edited:
Upvote 0
Code: 
With ThisWorkbook.Sheets("Sheet1")
 
    .OLEObjects.Add ClassType:="Forms.CommandButton.1", _
                    Height:=32.25, _
                    Left:=434.25, _
                    Top:=34.5, _
                    Width:=102.75
 
    With b2.OLEObjects("CommandButton1")
 
        .Name = "RecreateSheet"
        .Object.Caption = "Recreate Sheet"
        .Object.ForeColor = &HC0&
        .OnAction = "[B][COLOR=red]'[/COLOR][/B]Update[B][COLOR=red]'[/COLOR][/B]"
 
    End With
 
End With

After I read Juan's post in the other thread that was what I tried (that's the suggestion I was talking about in post #4). The same error message occurs.

Right now I'm reduced to inserting the code I want to use into the worksheet object module after I add it:

Code: 
b6 = "Private Sub Update_Click" & Chr(10) & Chr(10) & _
     "Call Code.Update" & Chr(10) & Chr(10) & _
     "End Sub" & Chr(10) & Chr(10) & _
     "Private Sub Format_Click()" & Chr(10) & Chr(10) & _
     "Do" & Chr(10) & Chr(10) & _
     "i = i + 1" & Chr(10) & Chr(10) & _
     "With ActiveSheet.Range(""M"" & i)" & Chr(10) & Chr(10) & _
     "    .Value = Range(""A"" & i) & "" - "" & Range(""B"" & i)" & Chr(10) & Chr(10) & _
     "End With" & Chr(10) & Chr(10) & _
     "Loop Until IsEmpty(Range(""A1"").Offset(i, 0))" & Chr(10) & Chr(10) & _
     "End Sub" & Chr(10) & Chr(10) & _
     "Private Sub Recreate_Click" & Chr(10) & Chr(10) & _
     "Call Code.Query" & Chr(10) & Chr(10) & _
     "End Sub"
 
'Inserts procedure
ThisWorkbook.VBProject.VBComponents(Sheets("Sheet1").CodeName).CodeModule.insertlines 1, b6

It's not pretty, but it works.
 
Upvote 0
I don't think the OnAction Property works for ActiveX controls and when added at runtime it is even a bit more involved because the Project is reset and all variables are gone out of scope.

Try this :

1- Add a Class Module to your Project and give the name of: CmbClass

Put this code in the Class module you just added.

Code: 
Option Explicit

Private WithEvents oCmb As CommandButton

Private Sub oCmb_Click()
    MsgBox "Hello from  " & "'" & oCmb.Caption & "'"
End Sub


Public Property Set GetCommandButton(ByVal Cmb As CommandButton)
    Set oCmb = Cmb
End Property
2- Put this in a Standard module and run the AddButton routine :

Code: 
Private oCmbInstance As CmbClass


Sub AddButton()

    Dim Cmb  As OLEObject
    
    Set Cmb = ThisWorkbook.ActiveSheet.OLEObjects.Add _
    (ClassType:="Forms.CommandButton.1", _
           Height:=32, _
           Width:=200, _
           Left:=292, _
           Top:=34, _
           Width:=102)
           
    Names.Add "ButtonID", Cmb.ShapeRange.ID
    Cmb.Name = "MyCommandButton" & Cmb.ShapeRange.ID
    Application.OnTime Now + TimeSerial(0, 0, 1), "HookButton"

End Sub

Private Sub HookButton()

    Set oCmbInstance = New CmbClass
    
    Set oCmbInstance.GetCommandButton = _
    ActiveSheet.OLEObjects("MyCommandButton" & [ButtonID]).Object
    Names("ButtonID").Delete

End Sub
 
Upvote 0
Glory said:
Code: 
With ThisWorkbook.Sheets("Sheet1")
 
    .OLEObjects.Add ClassType:="Forms.CommandButton.1", _
                    Height:=32.25, _
                    Left:=434.25, _
                    Top:=34.5, _
                    Width:=102.75
 
    With b2.OLEObjects("CommandButton1")
 
        .Name = "RecreateSheet"
        .Object.Caption = "Recreate Sheet"
        .Object.ForeColor = &HC0&
        .OnAction = "[B][COLOR=red]'[/COLOR][/B]Update[B][COLOR=red]'[/COLOR][/B]"
 
    End With
 
End With
After I read Juan's post in the other thread that was what I tried (that's the suggestion I was talking about in post #4). The same error message occurs.

Right now I'm reduced to inserting the code I want to use into the worksheet object module after I add it:

Code: 
b6 = "Private Sub Update_Click" & Chr(10) & Chr(10) & _
     "Call Code.Update" & Chr(10) & Chr(10) & _
     "End Sub" & Chr(10) & Chr(10) & _
     "Private Sub Format_Click()" & Chr(10) & Chr(10) & _
     "Do" & Chr(10) & Chr(10) & _
     "i = i + 1" & Chr(10) & Chr(10) & _
     "With ActiveSheet.Range(""M"" & i)" & Chr(10) & Chr(10) & _
     "    .Value = Range(""A"" & i) & "" - "" & Range(""B"" & i)" & Chr(10) & Chr(10) & _
     "End With" & Chr(10) & Chr(10) & _
     "Loop Until IsEmpty(Range(""A1"").Offset(i, 0))" & Chr(10) & Chr(10) & _
     "End Sub" & Chr(10) & Chr(10) & _
     "Private Sub Recreate_Click" & Chr(10) & Chr(10) & _
     "Call Code.Query" & Chr(10) & Chr(10) & _
     "End Sub"
 
'Inserts procedure
ThisWorkbook.VBProject.VBComponents(Sheets("Sheet1").CodeName).CodeModule.insertlines 1, b6
It's not pretty, but it works.
Click to expand...

I would avoid using the above approach because it needs a reference to the VB Extensibility library plus the security Trust access to VBA project MUST be set which is not guaranted in the user's computer and cannot be set programmatically. This would sooner or later error out and confuse the user.
 
Upvote 0
I think you better use DropDown. It's far less complicated than ActiveX.
Here's example:
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Call AddDropDown
    Cancel = True
End Sub

Sub AddDropDown()

    Dim dd As DropDown
    
    With ActiveCell
        Set dd = Sheet1.DropDowns.Add(.Left, .Top, .Width, .Height)
    End With

    With dd
        .Name = "dd1"
        .OnAction = "SomeSub" 'Assign action when item is selected.
        .AddItem "Item1"
        .AddItem "Item2"
        .AddItem "Item3"
    End With

End Sub

Private Sub SomeSub()

    With Sheet1.DropDowns(Application.Caller)
        .TopLeftCell = .List(.ListIndex) 'Add selected value to cell beneath DropDown.
        .Delete 'Delete DropDown.
    End With

End Sub
 
Upvote 0
Sektor: I'm going to stick with what I know for now, but thanks for the input.

Jaafar: There's four or five things going on in your code that are turning me for a loop. I'm working through most of it, but I'm left wondering about a couple of things.

1) I get an error when I step through the "AddButton" procedure. This makes it really hard to debug. Any idea why this is happening?

2) I've never worked with a shape range obejct before and I would prefer to work with the buttons' names if at all possible. But I can't seem to get the code to recognize the name of the button alone. Is it necessary to use a named range to refer to the button in your code?


Runs successfully, but fails to hook button:

Code: 
Option Explicit
 
Private WithEvents oCmb As CommandButton
 
Private Sub oCmb_Click()
    MsgBox "Hello from  " & "'" & oCmb.Caption & "'"
End Sub
 
Public Property Set GetCommandButton(ByVal Cmb As CommandButton)
    Set oCmb = Cmb
End Property

Code: 
Private oCmbInstance As CmbClass
 
Sub AddButton()
    Dim Cmb  As OLEObject
 
    Set Cmb = ThisWorkbook.ActiveSheet.OLEObjects.Add _
    (ClassType:="Forms.CommandButton.1", _
           Height:=32, _
           Width:=200, _
           Left:=292, _
           Top:=34, _
           Width:=102)
 
    Cmb.Name = "MyCommandButton"
 
    Call HookButton
 
End Sub
 
Private Sub HookButton()
    Set oCmbInstance = New CmbClass
    Set oCmbInstance.GetCommandButton = ActiveSheet.OLEObjects("MyCommandButton").Object
 
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

Q
  • Solved
VBA: Dynamically Create Active X Frame and Yes / No Radio Button
2
Replies
13
Views
246
Domenic
D
F
  • Question Question
Update userform
2
Replies
13
Views
284
Formula11
F
R
  • Solved
Form creation using vba instead of creating it ahead of time
Replies
1
Views
360
John_w
J
A
  • Question Question
How can I create a button to insert a new row and update related formulas?
Replies
0
Views
209
Arlochorim
A
P
  • Question Question
System error &H80004005 (-2147467259). Unspecified error
Replies
6
Views
430
jkpieterse
jkpieterse

Forum statistics

Threads
1,224,527
Messages
6,179,331
Members
452,907
Latest member
Roland Deschain

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top