Creating two buttons and code programmatically

[Paleo]

I need to create two buttons (at the same time) and add code to them. Not the same code for both. Each one must call a sub. I know how to add a code to the first button or add code to subsequente buttons, but only if i run the code twice and i need them to be added both the first time i run the code. Tried for ... next already but didnt succeed.

Any suggestions?

[Ken Puls]

Hi Carlos,

Nate Oliver helped me with this one a while ago. You should be able to modify the button names and procedure names to suit. Remember to set a reference to the VBA Extensibility Library and also to ensure that you've trusted access to the VB Project. (Tools|Options|Security|Macro Security|Trusted Publishers... or something like that!)

Sub Add_Command_Buttons()
'Macro purpose: To create 2 pre-formatted command buttons on the worksheet
'SECTION 1
 'Declare required variables and working environment
 Dim cl As Range, ctrl As OLEObject, i, LineNum As Integer
 Dim TargetSheet As Worksheet, TargetBook As Workbook
 Application.ScreenUpdating = False
 Set TargetSheet = ActiveSheet
 Set TargetBook = ActiveWorkbook
'SECTION 2
 'Add preformated buttons to worksheet
 For Each cl In [A1,I1] 'update this range to place buttons
     i = i + 1
     Set ctrl = TargetSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
         Left:=cl.Left + 1, Top:=cl.Top + 1, Width:=Choose(i, 48, 72.75), Height:=56.25)
     With ctrl
         .Name = Choose(i, "RollForward", "PrintAll_Standard")
         .Placement = xlMove
         .PrintObject = False
         With .Object
             .BackColor = Choose(i, &HC0FFC0, &HFFC0C0)
             .Caption = Choose(i, "Roll Forward To New Month", _
             "Print Working Paper & AJE")
             .Enabled = True
             .Font.Name = "Times New Roman"
             .Font.Size = 10
             .Font.Bold = True
             .TakeFocusOnClick = False
             .WordWrap = True
         End With
     End With
 Next
 'TargetBook.VBProject.VBComponents.Add(1) 'to add a new Module1
 With TargetBook.VBProject.VBComponents(TargetSheet.CodeName).CodeModule
         LineNum = .CountOfLines + 1
         .InsertLines LineNum, _
             "Private Sub RollForward_Click()" & vbLf & _
             "     Msgbox ""Here is the new procedure"" " & vbLf & _
             "End Sub"
 End With
With TargetBook.VBProject.VBComponents(TargetSheet.CodeName).CodeModule
         LineNum = .CountOfLines + 1
         .InsertLines LineNum, _
             "Private Sub PrintAll_Standard_Click()" & vbLf & _
             "     Msgbox ""Here is the new procedure"" " & vbLf & _
             "End Sub"
 End With
 Application.ScreenUpdating = True
 End Sub

[Paleo]

Hi Ken,

gee this is great! Exactly what I needed. Of course now I will try to alter it a bit as now I want to add 3 buttons, but reading the code believe its gonna be easy.

Thank you very much!

[Paleo]

Hi again Ken,

worked just fine, this is my final code:

Sub Add_Command_Buttons()
    Dim cl As Range, myCmdObj As OLEObject, i, LineNum As Integer
    Dim TargetSheet As Worksheet, TargetBook As Workbook
    Application.ScreenUpdating = False
    Set TargetSheet = ActiveSheet
    Set TargetBook = ActiveWorkbook
For Each cl In [A14,A20,A25]
        i = i + 1
        Set myCmdObj = TargetSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
        Left:=cl.Left + 1, Top:=cl.Top + 1, Width:=202.5, Height:=32.25)
    With myCmdObj
            .Name = Choose(i, "cmdReexibirNC", "cmdSubtotalNC", "cmdResumo")
            .Placement = xlMove
            .PrintObject = False
            With .Object
                .Caption = Choose(i, "Reexibe todas colunas e remove subtotais", _
                "Gera subtotais e oculta colunas", _
                "Analisa outras opera??es")
                .Enabled = True
                .Font.Size = 10
                .Font.Bold = True
                .TakeFocusOnClick = False
                .WordWrap = True
            End With
        End With
    Next
    Set myCmdObj = Nothing
    With TargetBook.VBProject.VBComponents(TargetSheet.CodeName).CodeModule
        LineNum = .CountOfLines + 1
        .InsertLines LineNum, "Private Sub cmdReexibirNC_Click()"
        .InsertLines LineNum + 1, vbNewLine
        .InsertLines LineNum + 2, vbTab & "Reexibe_NC"
        .InsertLines LineNum + 3, vbNewLine
        .InsertLines LineNum + 4, "End Sub"
    End With
With TargetBook.VBProject.VBComponents(TargetSheet.CodeName).CodeModule
        LineNum = .CountOfLines + 1
        .InsertLines LineNum, "Private Sub cmdSubtotalNC_Click()"
        .InsertLines LineNum + 1, vbNewLine
        .InsertLines LineNum + 2, vbTab & "Subtotal_NC"
        .InsertLines LineNum + 3, vbNewLine
        .InsertLines LineNum + 4, "End Sub"
    End With
With TargetBook.VBProject.VBComponents(TargetSheet.CodeName).CodeModule
        LineNum = .CountOfLines + 1
        .InsertLines LineNum, "Private Sub cmdResumo_Click()"
        .InsertLines LineNum + 1, vbNewLine
        .InsertLines LineNum + 2, vbTab & "Analisa"
        .InsertLines LineNum + 3, vbNewLine
        .InsertLines LineNum + 4, "End Sub"
    End With
    Application.ScreenUpdating = True
End Sub

[Ken Puls]

Glad it worked!

[Paleo]

Please ignore this thread, I have posted it here http://www.vbaexpress.com/forum/show...4586#post14586, answer there please.

Hi,

gee here I am again. Another problem. I need to put the buttons side by side and bellow a row I dont know which is.

I tried this:

For Each cl In [replace(Range("B65536").End(xlUp).Address,"$",""), replace(Range("D65536").End(xlUp).Address,"$",""), replace(Range("H65536").End(xlUp).Address,"$","")]

Didnt work. Any suggestions?

[Paleo]

This one is already solved, just read the previous, please.

This is the one I wanna change and t has another error. Two buttons are being positioned one above another. The ones from column "B".

For Each cl In [B5664,B5668,H5664] 'update this range to place buttons
i = i + 1
Set myCmdObj = TargetSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Left:=cl.Left + 1, Top:=cl.Top + 1, Width:=202.5, Height:=32.25)

Any suggestions about this thread and the one before it?