Excel VBA用户表单列表框dynamic上下文菜单使用.OnAction方法

我为Userform Listboxbuild立了一个dynamic的上下文菜单。

在此Listbox是一系列文件。 我的目标是，当你右键点击一个文件，上下文菜单popup一个文件夹的位置列表。 左击这些文件夹位置之一将文件复制到该位置。

我将使用 .CopyFile(Location, Destination, [Overwrite]) 方法来执行此操作。

我有困难dynamic分配.OnAction事件添加每个Item 。

Userform模块代码

 Option Explicit Private Const mCONTEXT_MENU_NAME = "myRightClickListbox" Private m_clsContextMenu As CContextMenu 'Function mySendTo(fName As String) 'MsgBox fName 'End Function Sub mySendTo(fName As String) MsgBox fName End Sub Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim myString As String: myString = "C:\myFolder\" Dim FolderName As String: FolderName = Dir("C:\myFolder\", vbDirectory) If Button = 2 Then '*\\Listbox right click context menu On Error Resume Next Application.CommandBars(mCONTEXT_MENU_NAME).Delete 'remove any previous instance On Error GoTo 0 Set m_clsContextMenu = New CContextMenu With CommandBars.Add(mCONTEXT_MENU_NAME, Position:=msoBarPopup) With .Controls.Add(Type:=msoControlPopup, before:=1, temporary:=True) .Caption = "Send to" i = 0 Do While FolderName <> "" If FolderName <> "." And FolderName <> ".." Then If (GetAttr(myString & FolderName) And vbDirectory) = vbDirectory Then i = i + 1 With .Controls.Add(Type:=msoControlButton, before:=i, temporary:=True) .FaceId = 23 .Caption = FolderName .Tag = "t" & FolderName .OnAction = "'mySendTo " & FolderName & "'" '.OnAction = "=mySendTo(" & FolderName & ")" '.Parameter = FolderName End With End If End If FolderName = Dir() Loop End With Set m_clsContextMenu.LBox = Me.ListBox1 End With '*// End If End Sub 

Class模块代码CContextMenu

 Public LBox As MSForms.ListBox 

上面的代码成功地创build了一个Userform Listbox右键激活的上下文菜单，该Userform Listbox包含一个子菜单Type:=msoControlPopup其中包含指定FolderName目录内每个文件夹的Items 。

我正在尝试为创build的每个Itemdynamic分配.OnAction事件来调用mySendTo Sub或Function 。 我已经被告知，你可能只能通过这种方式调用Functions名称，而调用具有自己的参数的子将失败。 没有我已经尝试了两个，似乎都没有工作。 尽pipe两者都触发Error: 400 ，这意味着Excel正试图调用该事件。

这两个事件只是触发一个MsgBox显示参数String （我已经做了这个简单，直到我知道代码正确运行）。

重要的是，当点击子菜单中的每个Item时，它会触发引用特定Item.Caption文本的代码 – 在这种情况下， FolderName目录内的子文件夹名称（它自己的位置）。

我打算从Listbox复制文件到由上下文子菜单Item指定的新的目标文件夹。

我知道我与我的.OnAction语法很接近，但是是否因为我误用我的Sub / Function与参数调用事件，或者因为我也试图dynamic地将.OnAction事件分配给已经dynamic创build上下文子菜单Item ，我只是不能为我的生活弄明白。

如果将上面的代码粘贴到一个空白的Userform模块中并添加一个名为“ListBox1”的Listbox ，则应该有一个带有子菜单的工作右键单击激活的上下文菜单。

如果您尝试单击这些Items之一，您还应该收到Error: 400 。

任何帮助，我可以通过一个dynamic的Sub或Function ，每个Item是一个参数是它自己的.Caption将不胜感激，再次感谢您的时间。

J先生

Answer 1

将所有的OnAction设置为一个没有参数的公共Sub。 然后在这个Sub中，使用Application.CommandBars.ActionControl来获取触发事件的特定命令栏项。 然后你可以得到一个命令栏项目的属性，标识你正在处理的项目。 .Parameter属性是最好的select。

在你的情况下，你可以只使用标题属性，我想…但这是危险的，因为你可能以后决定格式化，或截断它，或其他。 因此，请确保将命令项的“参数”字段设置为有问题的文件夹（您已经在代码中拥有 – 但注释掉了）。

所以在你的原始代码中：

 With .Controls.Add(Type:=msoControlButton, before:=i, temporary:=True) .Caption = FolderName 'etc etc .OnAction = "'MyWorkbookName.xlsx'!mySendTo" .Parameter = FolderName End With 

顺便说一下，总是在.OnAction中指定完全限定的macros名称。 我通过辛苦的经验学到了这一点。 确保始终把工作簿名称放在单引号中，就像我上面那样。 （引号并不总是需要的，但通常是…而且永远都不会受到伤害。）

然后在你的事件处理器中：

 Public Sub mySend() Dim sourceFolder as String On Error resume Next sourceFolder = Application.CommandBars.ActionControl.Parameter On Error goto 0 if sourceFolder <> "" Then GoOnAndDoWhatever(sourceFolder) End Sub