Results 1 to 8 of 8
  1. #1
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Programmatically Add Buttons (2K and higher)

    I've been experimenting with adding buttons to a worksheet. I have a macro that works fine:
    <pre>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.Comma ndButton.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.Co deName).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
    </pre>


    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:
    <pre>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.Comma ndButton.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
    </pre>

    And the macro to create the cPopBtn objects is:
    <pre>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
    </pre>


    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
    Attached Files Attached Files
    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Programmatically Add Buttons (2K and higher)

    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

  3. #3
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Programmatically Add Buttons (2K and higher)

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

  4. #4
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts

    Re: Programmatically Add Buttons (2K and higher)

    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.
    Regards,
    Rory

    Microsoft MVP - Excel

  5. #5
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Programmatically Add Buttons (2K and higher)

    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
    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  6. #6
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Programmatically Add Buttons (2K and higher)

    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
    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  7. #7
    Silver Lounger
    Join Date
    Mar 2001
    Location
    Springfield, Ohio, USA
    Posts
    2,136
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Programmatically Add Buttons (2K and higher)

    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.
    <pre>Option Explicit

    Sub BtnClick()
    MsgBox ActiveSheet.Shapes(Application.Caller).Alternative Text
    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
    </pre>

    Attached Files Attached Files
    <font face="Comic Sans MS">Sam Barrett, CACI </font face=comic>
    <small>And the things that you have heard... commit these to faithful men who will be able to teach others also. 2 Timothy 2:2</small>

  8. #8
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts

    Re: Programmatically Add Buttons (2K and higher)

    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

    <pre>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
    </pre>


    Normal code module:

    <pre>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
    </pre>


    In case anyone is interested! <img src=/S/grin.gif border=0 alt=grin width=15 height=15>
    Regards,
    Rory

    Microsoft MVP - Excel

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •