Excel VBA CommandBar.OnAction with params is difficult / does not perform as expected

So, I have Googled about and it seems that while making custom Pop up menus, if one wants to pass parameters then this is possible but for me comes with 2 major problems:

1) The function you call will execute, but you will not be able to activate a breakpoint on it, or even use Stop.

2) Oddly it seems to get called twice, which isn't very helpful either.

Code to illustrate ( please put in a module and not in a sheet )

Option Explicit

Sub AssignIt()

    Dim cbrCmdBar As CommandBar
    Dim strCBarName As String

    On Error Resume Next

    strCBarName = "MyNewPopupMenu"

    'Delete it first so multiple runs can occur without appending
    Application.CommandBars(strCBarName).Delete

    ' Create a menu bar.
    Set cbrCmdBar = Application.CommandBars.Add(Name:=strCBarName, Position:=msoBarMenuBar)

    ' Create a pop-up menu.
    strCBarName = "MyNewPopupMenu"
    Set cbrCmdBar = Application.CommandBars.Add(Name:=strCBarName, Position:=msoBarPopup)

    'DEFINE COMMAND BAR CONTROL
    With Application.CommandBars(strCBarName).Controls.Add(Type:=msoControlButton)
    .Caption = "MyMenu"
    .OnAction = BuildProcArgString("MyProc", "A", "B", "C") 'You can add any number of arguments here!
    End With

    'DEFINE COMMAND BAR CONTROL
    With Application.CommandBars(strCBarName).Controls.Add(Type:=msoControlButton)
        .Caption = "Test No Args"
  开发者_开发技巧      .OnAction = "CallWithNoArgs"
    End With


    Application.CommandBars(strCBarName).ShowPopup

End Sub


Sub CallWithNoArgs()

    MsgBox "No Args"

End Sub

'FUNCTION TO BUILD PROCEDURE ARGUMENTS (You just have to plop this in any of your modules)
Function BuildProcArgString(ByVal ProcName As String, ParamArray Args() As Variant)

    Dim TempArg
    Dim Temp

    For Each TempArg In Args
        Temp = Temp + Chr(34) + TempArg + Chr(34) + ","
    Next

    BuildProcArgString = ProcName + "(" + Left(Temp, Len(Temp) - 1) + ")"

End Function

'AND FINALLY - THE EXECUTABLE PROCEDURE!
Sub MyProc(x, y, z)

    MsgBox x & y & z
    Debug.Print "arrgggh why won't the breakpoint work, and why call twice!!!!!!"

End Sub

If someone could help with this, that would be great. It seems another developer in the past hit the wall and so for the 5 items we have Method_1 ... Method_5 with the number passed into Method_Core(ByVal i As Integer) style. I think I will take this route too although very ugly, it works better than what I have mocked up below.

PS. This is a quick mockup so I don't expose proprietary code etc

You can use the .Parameter property. This is an example of a code in production (with only the lines of interest):

        Dim i As Integer
        Set cl = MainForm.Controls("classroomList")
        For i = 0 To cl.ListCount - 1
            With .Controls.Add(Type:=msoControlButton)
                .Caption = cl.List(i)
                .faceId = 177
                .OnAction = "'" & ThisWorkbook.Name & "'!" & "assignClassroom"
                .Parameter = cl.List(i)
            End With
        Next i

And the procedure could be something like:

Public Sub assignClassroom(Optional someArg as SomeType)
' code here
CommandBars.ActionControl.Parameter 'The parameter here
' more code here
End Sub

Don't ask me why this works, but it does. Source for this info is Using procedures with arguments in non-obvious instances

Sub AssignIt()
Const strCBarName As String = "MyNewPopupMenu"
Dim cbrCmdBar As CommandBar

    'Delete it first so multiple runs can occur without appending
    On Error Resume Next
    Application.CommandBars(strCBarName).Delete
    On Error GoTo 0

    ' Create a pop-up menu.
    Set cbrCmdBar = Application.CommandBars.Add(Name:=strCBarName, Position:=msoBarPopup)

    'DEFINE COMMAND BAR CONTROL
    With Application.CommandBars(strCBarName).Controls.Add(Type:=msoControlButton)
        .Caption = "MyMenu"
        .OnAction = "'MyProc ""A"",""B"",2'"
    End With
    Application.CommandBars(strCBarName).ShowPopup
End Sub

Sub MyProc(x As String, y As String, z As Integer)
    MsgBox x & y & (z * 2)
    Debug.Print "AHA!!! the breakpoint works, and it's only called once!!!!!!"
End Sub

The key is to call the procedure in the .OnAction event surrounded by single quotes. Also, you need to escape your double quotes with double quotes. Numeric parameters need not be escaped.

The reason there are double calls and no break points is because of the parentheses (“( )”) surrounding the arguments in the .OnAction call:

    .OnAction = BuildProcArgString("MyProc", "A", "B", "C")

Best guess: The parser for .OnAction chokes when these parentheses are used.

This should work:

    .OnAction = "'BuildProcArgString" & chr(34) & "MyProc" & _
    chr(34) & "," & chr(34) & "A" & chr(34) & "," & chr(34) & _
    "B" & chr(34) & "," & chr(34) &  "C" &  "'"

Other Notes:

1) Single quotes, after the first double quote and before the last double quote, should be used to encapsulate the entire call.

2) Chr(34) is the ASCII character for double quotes (“). All data types (ints, longs, strings, etc.), and quoted commas need to be preceeded by a Chr(34). The one exception is the ending sinlge quote (" ' "). Example:

    .OnAction = "'m_Test" & Chr(34) & 100 & Chr(34) & "," & Chr(34) & _
     intVariable & Chr(34) & "," & Chr(34) & "String" & Chr(34) & _
     "," & Chr(34) & stringVariable & "'"

The function called:

    Public Function m_Test(i as Integer, iVar as Integer, s as String, sVar as String)

3) .OnAction does not seem to pass Arrays or Objects. An item in an array can be passed (e.g. .OnAction = "'myTest" & Chr (34) & Args(0) & "'"), but not the entire Array (e.g. .OnAction = "'myTest" & Chr (34) & Args & "'"). Object pointers can be passed (ref: http://www.access-programmers.co.uk/forums/showthread.php?t=225415). But I've had no success in passing pointers to arrays.

4) The .OnAction used in the original example is not surrounded by quotation marks so the .OnAction call is made when AssignIt() gets called but before the popup menu pops up.