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

Ok. I'm posting some code that I've been working on based on this post here: Multiple active X checkboxes... . It seems I've now come to the same stand still they did as descibed in their last post :

"Yes it is individual checkboxes. You can emulate control arrays in VBA so that each checkbox uses the same click event code, but that is probably overkill IMO. "

And if I read Jason's post above, this is what he's questioning regarding the event code.

Any assistance welcomed in completing this code, as I have Not yet seen a working example which interlocks it to a single event, as per the form button module above.

    Sub Macro1()

Dim objCmdBtn As Object
Dim i As Integer
Dim Rnge As Range

Set ColumnRange = Range("A:A") ' Set width & height of column A
    ColumnRange.ColumnWidth = 5: ColumnRange.RowHeight = 15.75

'Delete previous objCmdBtn
For Each objCmdBtn In ActiveSheet.OLEObjects
    If TypeName(objCmdBtn.Object) = "CommandButton" Then objCmdBtn.Delete
    Next objCmdBtn 'TypeName Function returns the data-type about a variable - TypeName(varname is objCmdBtn)



    With ActiveSheet

        For i = 1 To 25

            Set Rnge = ActiveSheet.Range(Cells(i + 1, 1), Cells(i + 1, 1))
            Set objCmdBtn = Sheets("Sheet1").OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
                                     Link:=False, _
                                     DisplayAsIcon:=False, _
                                     Left:=Rnge.Left, _
                                     Top:=Rnge.Top, _
                                     Width:=Rnge.Width, _
                                     Height:=Rnge.Height)

                                     With objCmdBtn
                                        'set a String value as object's name
                                        '.Name = "CommandButton1"

                                        With .Object
                                             .Caption = i
                                             With .Font
                                                  .Name = "Arial"
                                                  .Bold = True
                                                  .Size = 7
                                                  .Italic = False
                                                  .Underline = False
                                             End With
                                        End With
                                    End With
        Next
    End With

End Sub

Answer 2

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"