Search code examples
vbaexcelexcel-2013

Dynamically call a macro passing parameters from shape OnAction property


Well, my problem is that I have created a VBA Sub that receives an excel Cell reference and 2 text values and a Variant as parameter.

Sub CreateButton(oCell, sLabel, sOnClickMacro, oParameters)

This Sub succeeds in creating a button over the oCell but I must send a parameter to the Macro what is the best way to achieve that ?

If have digged some ways that doesn't worked and also others dirty that dont make me fill confortable


With the help given I managed to resolve the problem, I'm putting down here a simpler working solution for that

Sub Button_Click(sText)
    MsgBox "Message: " & sText
End Sub

Sub Test_Initiallize()
    Dim oCell
    Dim oSheet
    Dim oShape

    Set oCell = Range("A1")
    Set oSheet = ThisWorkbook.Sheets(1)

    For Each oShape In oSheet.Shapes
        oShape.Delete
    Next

    Set oShape = oSheet.Shapes.AddShape(msoShapeRectangle, oCell.Left, oCell.Top,     oCell.Width, oCell.Height)

    oShape.TextFrame.Characters.Text = "Click Me"
    oShape.OnAction = "'Button_Click ""Hello World""'"
End Sub

Solution

  • You can assign a string to OnAction that has the sub to call followed by its arguments (note the whole string wrapped in single quotes)

    Like:

    Shape.OnAction = "'SubToCallOnAction ""Hello World!""'"
    
    Sub SubToCallOnAction(text As String)
    
        MsgBox text
    
    End Sub
    

    Numeric arguments don't need the quotes (though they will be passed in via Number -> default string conversion -> default number conversion)

    So, I guess, what you are wanting to do is pass in the name of the button that was clicked:

    Shape.OnAction = "'SubToCallOnAction """ & Shape.Name & """'"
    

    More advanced and flexible usage could be something like:

    'Set the button up like:
    databaseTable = "tbl_ValidAreas"
    databaseField = "Country"
    Shape.OnAction = _
        "'SubToCallOnAction """ & _
        Shape.Name & """ """ & _
        databaseTable & """ """ & 
        databaseField & """'"
    
    ...
    Sub SubToCallOnAction(buttonID As String, ParamArray args)
    
        Select Case buttonID
            Case "button1"
                'get the relevant data or whatever using the ParamArray args
                Call GetData(args(0),args(1))
            ...
        End Select
    
    End Sub