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

[Glory]

Code creates button. How do I link the button with some code?

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

 

[Glory]

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?

 

[Ruddles]

I think you just set the object's .OnAction property to the name of the macro you want it to execute.

 

[Glory]

Found this suggestion: http://www.mrexcel.com/forum/showthread.php?p=2715289

The suggestion doesn't appear to solve the problem.

 

[Ruddles]

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:-

[SIZE=3].OnAction = [COLOR=red]"[/COLOR]'mymacro 99'[COLOR=red]"[/COLOR][/SIZE]

or:-

[SIZE=3].OnAction = [COLOR=red]"[/COLOR]'mymacro [COLOR=magenta]""[/COLOR]fred[COLOR=magenta]""[/COLOR]'[COLOR=red]"[/COLOR][/SIZE]

 

[Glory]

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:

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.

 

[Jaafar Tribak]

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.

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 :

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

 

[Jaafar Tribak]

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:

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.

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.

 

[Sektor]

I think you better use DropDown. It's far less complicated than ActiveX.
Here's example:

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

 

[Glory]

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:

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

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