带有参数的 Excel VBA CommandBar.OnAction 很难/无法按预期执行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5665270/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA CommandBar.OnAction with params is difficult / does not perform as expected
提问by FinancialRadDeveloper
So, I have Googled about and it seems that while making custom Pop up menus, if one wants to pass parameters then this is possiblebut 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.
1) 您调用的函数将执行，但您将无法在其上激活断点，甚至无法使用 Stop。
2) Oddly it seems to get called twice, which isn't very helpful either.
2）奇怪的是它似乎被调用了两次，这也不是很有帮助。
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.
如果有人可以帮助解决这个问题，那就太好了。似乎过去的另一位开发人员碰壁了，因此对于 5 个项目，我们有 Method_1 ... Method_5 并将数字传递给 Method_Core(ByVal i As Integer) 样式。我想我也会走这条路线，虽然非常丑陋，但它比我在下面模拟的效果更好。
PS. This is a quick mockup so I don't expose proprietary code etc
附注。这是一个快速模型，所以我不会公开专有代码等
回答by Sebastian
You can use the .Parameter property. This is an example of a code in production (with only the lines of interest):
您可以使用 .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
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
回答by mwolfe02
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 .OnActionevent surrounded by singlequotes.Also, you need to escape your double quotes with double quotes. Numeric parameters need not be escaped.
关键是在单引号括起来的.OnAction事件中调用过程。此外，您需要用双引号转义双引号。数字参数不需要转义。
回答by Matt W
The reason there are double calls and no break points is because of the parentheses (“( )”) surrounding the arguments in the .OnAction call:
有两次调用并且没有断点的原因是因为 .OnAction 调用中的参数周围有括号（“（）”）：
.OnAction = BuildProcArgString("MyProc", "A", "B", "C")
Best guess: The parser for .OnAction chokes when these parentheses are used.
最佳猜测：当使用这些括号时，.OnAction 的解析器会阻塞。
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.
1）单引号，在第一个双引号之后，最后一个双引号之前，应该用来封装整个调用。
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:
2) Chr(34) 是双引号 (") 的 ASCII 字符。所有数据类型（整数、长整数、字符串等）和带引号的逗号都需要以 Chr(34) 开头。唯一的例外是结尾的单引号 (" ' ")。例子：
.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.
3) .OnAction 似乎不传递数组或对象。可以传递数组中的项目（例如 .OnAction = "'myTest" & Chr (34) & Args(0) & "'"），但不能传递整个数组（例如 .OnAction = "'myTest" & Chr ( 34) & 参数 & "'")。可以传递对象指针（参考：http://www.access-programmers.co.uk/forums/showthread.php?t= 225415）。但是我在将指针传递给数组方面没有成功。
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.
4) 原始示例中使用的 .OnAction 没有用引号括起来，因此 .OnAction 调用是在调用 AssignIt() 时但在弹出菜单弹出之前进行的。
