How to add activeX buttons programmatically in VBA, filling all rows down a column

Question

My first post here, but have been successfully sourcing solutions and ideas from this website for a while now. So thanks for the collection of solutions and ideas.

Answer 1

Here is an example of ActiveX buttons being created and coded to run. It may take some small tweaks, but will get the job done.

Sub CreateButton()            

Dim Obj As Object            
Dim Code As String            
Dim cellLeft As Single
Dim cellTop As Single
Dim cellwidth As Single
Dim cellheight As Single
Dim LineQty as Integer

Sheets("Sheet1").Select  

LineQty = 5

For i = 1 To LineQty
Set rng = ActiveSheet.Range(Cells(i, 1), Cells(i, 1))
    cellLeft = rng.Left
    cellTop = rng.Top
    cellwidth = rng.Width
    cellheight = rng.Height
    'create button            
    Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=cellLeft, Top:=cellTop, Width:=cellWidth, Height:=cellHeight)            
    Obj.Name = "TestButton"            
    'button text            
    ActiveSheet.OLEObjects(1).Object.Caption = "Test Button"            

    'macro text to be added possibly by array?           
    Code = "Private Sub TestButton_Click()" & vbCrLf            
    Code = Code & "Call Tester" & vbCrLf            
    Code = Code & "End Sub"            
    'add macro at the end of the sheet module            
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule            
        .insertlines 
        .CountOfLines + 1, Code            
    End With 

Next i

End Sub            

Sub Tester()            
    MsgBox "You have clicked on the test button"            
End Sub

Note In order for this to not error on me, I had to go to the trust center and to trust center settings and macro settings and check the box "Trust Access to the VBA Project Object Model"