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