Programmatically Adding Buttons to a Worksheet

[Festus Hagen]

Hi All,

Adding buttons, After lots of diggin and reading I have finally gotten it to work ONE button at a time ... It crashes on the second iteration. (when it attempts to Add the second button)

Here is where I am at, If I add an "Application.ActiveWorkbook.Save" at the end of the loop before it iterates the second time, the first button is created and works fine (after re-opening the wb)

If I remove the Code Adding 'With' block it works fine, whats the point without the code for them to act upon ...

Setting ooButton.Name is pointless, it appears it's not the correct property that matches the procedure name ... No big deal, I really don't care about the button names or procedure names as long as they work!
My choice would be:

  ooButton.Name = Format(rRange.Offset(1), "mmmmdd")
  ooButton.OnAction = Format(rRange.Offset(1), "mmmmdd")

Never could get them to hook up, tried many different methods, Different Quotes, etc ...

For cleanup/testing ...

Sub DelButtons()
Dim oObject As OLEObject
  Sheet2.Activate
  For Each oObject In Sheet2.OLEObjects
    oObject.Delete
  Next
End Sub

Sub AddButtons()
Dim rRange As Range
Dim ooButton As OLEObject
Dim lLines As Long
Dim sString As String
    
  Sheet2.Activate

  Set rRange = Sheet2.Range("B1")
  While rRange.Value <> ""
    Set ooButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, DisplayAsIcon:=False, Left:=rRange.Left, _
      Top:=rRange.Top, Width:=rRange.Width, Height:=rRange.Height)
    ooButton.Placement = xlMoveAndSize
    ooButton.PrintObject = False
    ooButton.Object.Caption = rRange.Value
    ooButton.Object.TakeFocus******* = False
    sString = vbNewLine & _
      "Private Sub " & ooButton.Name & "_Click()" & vbCrLf & _
      "  ActiveWorkbook.Names(" & Chr(34) & "PicksPasteZone" & Chr(34) & ").RefersTo = " & Chr(34) & "=" & rRange.Offset(2).Address & vbCrLf & _
      "End Sub" & vbNewLine
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
      .InsertLines 2, sString
    End With
    
    Set ooButton = Nothing
    Set rRange = rRange.Offset(, 1) ' Step by Column
  Wend
End Sub

Thanks y'all!

-Enjoy
fh <font color="#FF0000">:</font> )_~