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.

Basically, I have a spread sheet application requiring the first column, Column A, to be filled with "Active X" buttons in every cell, looping through for a given quantity. I have posted one such working solution below which makes use of "form type buttons" and a Modules. This exemplifies what I consider my most favored example with working buttons. Once operational the column of buttons will correspond to relative data on the same row, and when clicked will open corresponding folders, and userforms in later developments.

The second post uses the Range function, but obviously doesn't incorporate any buttons to interactive with. However, a mouse click over this Range will obviously activate any code from within the Worksheet_Selection Change procedure...Sorry just stating the obvious!

What I have been trying to achieve is a version of code employing "activeX" Command Buttons, but after having studied some great tutorials and poured over a range of programing concepts, I still fail miserably to employ OLEObjects.

How to add a button programmatically in VBA next to some sheet cell data?

Sheet 1 Procedure: Sub ColumnA_Buttons()

    Dim buttons As Button
    Dim rng As Range
    Dim LineQty As Variant

        Application.ScreenUpdating = False
        ActiveSheet.buttons.Delete

    LineQty = 5

    For i = 1 To LineQty
        Set rng = ActiveSheet.Range(Cells(i, 1), Cells(i, 1))
        Set buttons = ActiveSheet.buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)

            With buttons
                .OnAction = "Buttons"
                .Caption = "Line " & i
                .Name = "Line " & i
                End With
        Next i

        Application.ScreenUpdating = True

End Sub

Public Click_Button As Variant ' Make Variable Public for Userform1

'

Form Button Module:

Sub Line_Buttons()

 Click_Button = Application.Caller

    MsgBox Click_Button & " was Clicked"

        UserForm1.Show 'Launch custom userform

End Sub

And the next option to be considered is a range detection

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  ' e.g., range(A1:E1) is clicked
       If Not Application.Intersect(Target, Range("B2:B12")) Is Nothing Then
            MsgBox "You clicked " & Target.Address
       End If
End Sub

score 1 · Answer 1 · answered Jul 27 '16 at 14:16

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

score 0 · Answer 2 · answered Jul 25 '16 at 16:56

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"

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

2 Answers2

Linked

Related