Programmatically Add Buttons (2K and higher)

Topic

New Reply

I’ve been experimenting with adding buttons to a worksheet. I have a macro that works fine:

Option Explicit

Sub SimpleAdd()
    Dim s As String
    Dim btn As OLEObject
    
    ' Add the button
    With ActiveCell
        s = .Address(False, False)
        Set btn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
                    Link:=False, DisplayAsIcon:=False, _
                    Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
    End With
    btn.Name = "btn" & s
    btn.Object.Caption = s

    ' Add the code
    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        Dim n As Long
        n = .CountOfLines
        .InsertLines n + 1, "Private Sub " & btn.Name & "_Click()"
        .InsertLines n + 2, "MsgBox ""Click on " & s & """"
        .InsertLines n + 3, "End Sub"
    End With
End Sub

However,I do not want to add the button click code to the worksheet’s code module. So, I am using a class instead. The class code is in a Class called cPopBtn:

Option Explicit

Private mBtn As OLEObject
Private WithEvents btnControl As MSForms.CommandButton
Private mAdr As String

Public Sub Init(cell As Range)
    Dim ws As Worksheet
    Set ws = cell.Parent
    mAdr = cell.Address(False, False)
    With cell
        Set mBtn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
                    Link:=False, DisplayAsIcon:=False, _
                    Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
        Set btnControl = mBtn.Object
        btnControl.Caption = mAdr
    End With
End Sub

Private Sub btnControl_Click()
    MsgBox "Class from " & mAdr
End Sub

And the macro to create the cPopBtn objects is:

Option Explicit

Private mPopBtns() As cPopBtn
Private mCount As Integer

Sub ClassyAdd()
    ReDim Preserve mPopBtns(mCount)
    Set mPopBtns(mCount) = New cPopBtn
    mPopBtns(mCount).Init ActiveCell
    mCount = mCount + 1
End Sub

Sub Dump()
    MsgBox "Count is " & mCount
End Sub

The “ClassyAdd” creates buttons on the worksheet, but the object disappears. If you run ClassyAdd and then Dump, mCount is still zero and the mPopBtns array is empty just as if a VBA Reset has occured. Any clues as to why the class does not work? I have attached the worksheet. TIA –Sam

Reply | Quote

Replies

Would it be acceptable to create a button from the Forms toolbar? You could use a procedure like this:

Sub CreateFormButton(oCell As Range, strCaption As String, strMacro As String)
‘ oCell is the cell (or range) where the button will be created
‘ strCaption is the caption for the button
‘ strMacro is the name of the macro to be executed by clicking the button
Dim shp As Shape
With oCell
Set shp = ActiveSheet.Shapes.AddFormControl(xlButtonControl, _
.Left, .Top, .Width, .Height)
End With
With shp
.TextFrame.Characters.Text = strCaption
.OnAction = strMacro
End With
End Sub

Here is an example of how to call CreateFormButton:

Sub Test()
CreateFormButton ActiveCell, ActiveCell.Address(False, False), “MyMacro”
End Sub

Reply | Quote

BTW, I don’t know why your code doesn’t work, I don’t know enough about class modules.

Reply | Quote

I have seen mentions of this problem before relating to OLEObjects. They seem to cause a recompile of the workbook project, thereby resetting the variables. If you run the code from another workbook, it should be OK I think, or use Forms controls as Hans suggested.

Reply | Quote

Thanks, that helps. I will only want to create all of the buttons at a single shot, just don’t know how many or where untill run time, so I can create all of the buttons in the macro in an initial loop and then create objects from the buttons in another loop. I’ll try it on the test program tonight or tomorrow and post the code back here for the next person that wants to try it. –Sam

Reply | Quote

OK, I give up. You cannot use the de######, but I put in MsgBox’s and with a little bit of code rearrangement, it works perfectly: creates an array of button objects. But, it resets the variables at the end of the macro, thereby releasing any objects created. It can be done with two macros, one to create the buttons and another to define the objects, but I just want a single macro. So, I’m reverting back to Hans’s Forms control solution, except that I think that I’ll use a picture that looks like a button: you can also assign a macro to a picture. Thanks for trying! –Sam

Reply | Quote

So, here is a working demo. I have a blank worksheet with a single picture in J1, named ImgProto. The code is, of course, much simpler, just two macros in a code module. I’ve attached the demo workbook.

Option Explicit

Sub BtnClick()
    MsgBox ActiveSheet.Shapes(Application.Caller).AlternativeText
End Sub

Sub AddButtons()
    ' Save current selection
    Dim selSave As Variant
    Set selSave = Selection
    
    ' Create Buttons
    Dim cell As Range, s As String
    With ActiveSheet
        For Each cell In .Range("A1:C2").Cells
            .Shapes("ImgProto").Copy
            cell.Select
            .Paste
            Selection.OnAction = "BtnClick"
            s = cell.Address(False, False)
            Selection.ShapeRange.Name = "Button " & s
            Selection.ShapeRange.AlternativeText = s
        Next cell
    End With
    
    'Restore selection
    selSave.Select
End Sub

Reply | Quote

As it happens, a similar problem came up again today in another forum and I happened to have a bit more free time, so here’s an example of the sort of code required to hook up a textbox (it does, as Sammy said, require two stages):
Class module called CTextboxHandler

Option Explicit
Private WithEvents mtb As MSForms.TextBox
Private Sub mtb_Change()
   MsgBox mtb.Text
End Sub
Public Property Set ChangeTB(txtIn As MSForms.TextBox)
   Set mtb = txtIn
End Property

Normal code module:

Option Explicit
Dim clsNew As CTextboxHandler

Sub testitNew()
   Dim tb As OLEObject
   Set tb = ActiveSheet.OLEObjects.Add(Left:=100, Top:=100, Width:=100, _
            Height:=200, ClassType:="Forms.Textbox.1")
   tb.Name = "HookMe"
   Application.OnTime Now(), "'HookitUp ""HookMe""'"
End Sub

Sub HookitUp(strName As String)
   Set clsNew = New CTextboxHandler
   Set clsNew.ChangeTB = ActiveSheet.OLEObjects(strName).Object
End Sub

In case anyone is interested!

Reply | Quote