Create button with VBA

[wikus]

I am using this code to create buttons beneath each other. I am trying to change it to create the buttons next to each other on the same line, sized with the columns. Any help will be appreciated.

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 = 10
    ' 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:=10, Top:=Hght, _
        Width:=50, Height:=20)
    ' Define buttons name
    myCmdObj.Name = NName
    ' Define buttons caption
    myCmdObj.Object.Caption = "Calc-" & Range("D1").Value
    ' Inserts code for the button
    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        N = .CountOfLines
        .InsertLines N + 1, "Private Sub " & NName & "_Click()"
        .InsertLines N + 2, vbneline
        .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

 

[AlphaFrog]

This fills buttons to the right in row 2. Buttons fit the size of each cell.

[COLOR=darkblue]Sub[/COLOR] AddButtonAndCode()
    [COLOR=green]' Declare variables[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], [COLOR=#ff0000]lRow As Long, lCol As Long[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] Name [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], NName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=green]' Set the button properties[/COLOR]
    i = 0
    [COLOR=#ff0000]lRow = 2 [/COLOR][COLOR=#008000]'Fill buttons in this row[/COLOR][COLOR=#ff0000]
    lCol = 1 [/COLOR][COLOR=#008000]'Add new button in this column plus previous buttons[/COLOR]
    [COLOR=green]' Set the name for the button[/COLOR]
    NName = "cmdAction" & i
    [COLOR=green]' Test if there is a button already and if so, increment its name[/COLOR]
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] OLEObject [COLOR=darkblue]In[/COLOR] ActiveSheet.OLEObjects
        [COLOR=darkblue]If[/COLOR] Left(OLEObject.Name, 9) = "cmdAction" [COLOR=darkblue]Then[/COLOR]
            Name = Right(OLEObject.Name, Len(OLEObject.Name) - 9)
            [COLOR=darkblue]If[/COLOR] Name >= i [COLOR=darkblue]Then[/COLOR]
                i = Name + 1
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
            NName = "cmdAction" & i
            [COLOR=#ff0000]lCol = lCol + 1[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR]
    [COLOR=green]' Add button[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] myCmdObj [COLOR=darkblue]As[/COLOR] OLEObject, N%
    [COLOR=darkblue]Set[/COLOR] myCmdObj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
        Link:=False, DisplayAsIcon:=False, [COLOR=#ff0000]Left:=Columns(lCol).Left + 1, Top:=Rows(lRow).Top + 1, _
        Width:=Columns(lCol).Width, Height:=Rows(lRow).Height[/COLOR])
[COLOR=#008000]'
'
'[/COLOR]

 

[wikus]

Thanks very much it works perfectly.