FiveTech Support Forums

 Sub AddButtonAndCode() 
     ' Declare variables
    Dim i As Long, Hght As Long 
    Dim Name As String, NName As String 
     ' Set the button properties
    i = 0 
    Hght = 305.25 
     ' Set the name for the button
    NName = "cmdAction" & i 
     ' Test if there is a button already and if so, increment its name
    For Each OLEObject In ActiveSheet.OLEObjects 
        If Left(OLEObject.Name, 9) = "cmdAction" Then 
            Name = Right(OLEObject.Name, Len(OLEObject.Name) - 9) 
            If Name >= i Then 
                i = Name + 1 
            End If 
            NName = "cmdAction" & i 
            Hght = Hght + 27 
        End If 
    Next 
     ' Add button
    Dim myCmdObj As OLEObject, N% 
    Set myCmdObj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _ 
    Link:=False, DisplayAsIcon:=False, Left:=52.5, Top:=Hght, _ 
    Width:=202.5, Height:=26.25) 
     ' Define buttons name
    myCmdObj.Name = NName 
     ' Define buttons caption
    myCmdObj.Object.Caption = "Click for action" 
     ' Inserts code for the button
    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule 
        N = .CountOfLines 
        .InsertLines N + 1, "Private Sub " & NName & "_Click()" 
        .InsertLines N + 2, vbNewLine 
        .InsertLines N + 3, vbTab & "MsgBox(" & """" & "Button Clicked!" & """" & " & vbCrLf &" & _ 
        """" & "Put your code here!" & """" & " & vbCrLf & " & """" & "This is " & """" & _ 
        "& " & """" & NName & """" & ")" 
        .InsertLines N + 4, vbNewLine 
        .InsertLines N + 5, "End Sub" 
    End With 
End Sub