How to create an ActiveX button and add code to it (tell it what sub to run) using vba?

[mountainclimber11]

Hello. I'd like to create an ActiveX button in a sheet and assign a code to it (i.e. tell it to what sub to run and that sub already exists).

I can create the button: (recorded)

    ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
        , DisplayAsIcon:=False, Left:=41395.5882352941, Top:=234.705882352941, _
        Width:=119.117647058824, Height:=39.7058823529412).Select

But I'd like to change the caption and assign a sub to it so when someone clicks the newly created activex button it runs a sub that already lives in a module within the workbook that the button is to be created. Everything happens and lives in ThisWorkbook.

Thanks!

PS - I cannot use a Command button....I can only use ActiveX

 

[mountainclimber11]

adapted from:

Adding an Active X command button and its code using in Excel VBA

Sub AddingButtons()


    Dim btn As Button
    Dim t As Range
    Dim Obj As Object
    Dim Code As String
    
    Dim ShtNm As String
    With ThisWorkbook
        .Worksheets.Add(After:=Worksheets(1)).Name = "My New Worksheet"
        .Sheets("My New Worksheet").Activate
    End With
    
    ShtNm = ActiveSheet.Name
    Sheets(ShtNm).Select
    
    Set t = ActiveSheet.Range("D3:F4")


'create button
    Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
           Link:=False, DisplayAsIcon:=False, Left:=t.Left, Top:=t.Top, Width:=t.Width, Height:=t.Height)


'button text
    ActiveSheet.OLEObjects(1).Object.Caption = "Show Data Selection Window"


'macro text
    Code = "Private Sub CommandButton1_Click()" & vbCrLf
    Code = Code & "Call MyTestSub(ShtNm)" & vbCrLf
    Code = Code & "End Sub"


MsgBox "Worksheet name is " & ActiveSheet.Name
'add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(Worksheets(ShtNm).CodeName).CodeModule
        .insertlines .CountOfLines + 1, Code
End With


End Sub