excelvbaactivexcommandbuttonprogrammatically-created

Generating ActiveX Command Buttons and assigning code to them externally in VBA


I'm working on a task where it needs to generate ActiveX Command Buttons dynamically and assign certain code to them automatically. Each time I close the Worksheet, the command button needs to be deleted (it is completed), but code for that button remains.

So I'm trying to find code which will assign a code to the command button while checking if same sub exists, if it exists then delete it and create new sub with same name having the code I need.

My code is

Public WS As Worksheet


Sub MyButton()

Dim j, p, q As Integer
Dim ShButton As OLEObject
Dim rng As Range
Dim Code As String

Set WS = ThisWorkbook.Worksheets("Sheet1")

j = 0
p = 1
q = 3

For j = 29 To WS.Cells(Rows.Count, "E").End(xlUp).Row
    Set rng = WS.Range("C" & j)

    Set ShButton = WS.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, _
            Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.RowHeight * 3 / 4)
    
    WS.OLEObjects("CommandButton" & q).Object.Caption = "My Button " & p
    WS.OLEObjects("CommandButton" & q).Object.WordWrap = True
    
    
    ' ##Need code to Check Duplicate sub and delete it if exists

    Code = ""
    Code = "Private Sub CommandButton" & q & "_Click()" & vbCrLf
    Code = Code & "MsgBox " & Chr(34) & "Worksheet name is " & Chr(34) & " & ActiveSheet.Name" & vbCrLf  ' ##Demo Code
    Code = Code & "End Sub"
    Debug.Print Code
    
    With ActiveWorkbook.VBProject.VBComponents(Worksheets("Sheet1").CodeName).CodeModule
        .insertlines .CountOfLines + 1, Code
    End With
    
    
    
    
    p = p + 1
    q = q + 1
Next j

End Sub

OR Simply to add a code to command button programmatically and delete the previous same name code will do also


Solution

  • Thanks @funthomas for your suggestion. As per your suggestion, I've tried adding simple button and OnAction Command to it, and it simplified my code also (I no longer needed to create new sub for this)

    I'll share the code I've modified

       For i = 1 To UBound(arrFile)
        strtRow = 29
        Set ParamWS = ThisWorkbook.Worksheets("Sheet1")
        ' My other code is here to print data starting from Row 29(each row in each loop)
    
        Set rng = ParamWS.Range("C" & strtRow)
        p = strtRow - 28
        Set ShButton = ParamWS.Buttons.Add(Left:=43.5, Top:=rng.Top + 10, Width:=92, Height:=46)
    
        With ShButton
          .OnAction = "Module3.create_sheetFromButton"
          .Caption = "Single Button" & p
          .Name = strtRow
        End With
    
        strtRow = strtRow + 1
    
       Next i
    

    I'm deleting all the buttons at the end of my main code, also I'm not creating any new sub for buttons (Thanks to the suggestion of OnAction), so I don't need to check for duplicate sub.