带有参数的Excel VBA CommandBar.OnAction很难/不能按预期执行

Question

所以,我已经谷歌搜索了,似乎在制作自定义弹出菜单时,如果想要传递参数,那么这是可能的,但对我来说有两个主要问题:

1)您调用的函数将执行,但您将无法在其上激活断点,甚至无法使用Stop.

2)奇怪的是它似乎被召唤两次,这也不是很有帮助.

代码说明(请放入模块而不是表格中)

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

如果有人可以帮忙解决这个问题,那就太好了.似乎过去的另一个开发人员碰壁了,所以对于5个项目我们有Method_1 ... Method_5,其数字传递给Method_Core(ByVal i As Integer)样式.我想我会采取这条路线虽然非常难看,但它比我在下面嘲笑的更好.

PS.这是一个快速的模型,所以我不公开专有代码等

Answer 1

不要问我为什么会这样,但确实如此.此信息的来源是在非显而易见的实例中使用带参数的过程

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

关键是在单引号.OnAction包围的事件中调用该过程. 此外,您需要使用双引号来转义双引号.无需转义数字参数.

Answer 2

您可以使用.Parameter属性.这是生产中的代码示例(仅包含感兴趣的行):

        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

程序可能是这样的:

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