Question

我为Userform Listbox建立了动态上下文菜单。

此Listbox内是系列文件。我的目标是当您右键单击文件时，会弹出一个上下文菜单，其中包含文件夹位置列表。左键单击其中一个文件夹位置会将文件复制到该位置。

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

我很难为添加的每个.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

上面的代码成功为Userform Listbox创建了一个右键单击激活的上下文菜单，其中包含指定了Type:=msoControlPopup的子菜单Items FolderName目录。

我正在尝试为创建的每个.OnAction动态分配Item个事件，以调用mySendTo Sub或Function。我被告知您只能以这种方式通过名称调用Functions，并且使用自己的参数调用Sub将失败。尽管如此，我已经尝试了两者，似乎都没有效果。虽然两者都触发Error: 400，这意味着Excel正在尝试调用该事件。

这两个事件只触发显示参数MsgBox的{{1}}（为了简单起见，我已经这样做了，直到我知道代码正确运行）。

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

我打算将文件从FolderName复制到上下文子菜单Listbox指示的新目标文件夹。

我知道我接近我的Item语法但不管是因为我错误地使用了我的.OnAction / Sub参数调用事件，还是因为我是还尝试动态地将Function事件分配给已经动态创建的上下文子菜单.OnAction，我只是不能为我的生活弄明白。

如果您将上述代码粘贴到空白Item模块中并添加名为“ListBox1”的Userform，您应该使用子菜单右键单击激活的上下文菜单。

如果您尝试点击其中一个Listbox，您还应该收到Items。

有关如何将动态Error: 400或Sub传递给每个Function且参数为自己Item的任何帮助都 >赞赏，再次感谢您的时间。

先生。 Ĵ

Answer 1

将所有OnAction设置为不带参数的公共Sub。然后在Sub中，使用Application.CommandBars.ActionControl获取触发事件的特定命令栏项。然后，您可以获取命令栏项的属性，该属性标识您正在处理的项目。 .Parameter属性是最佳选择。

在你的情况下你可以使用我想的Caption属性......但这很危险，因为你可能以后决定格式化它，或截断它，或者其他什么。因此，请确保将命令项的参数字段设置为有问题的文件夹（您的代码已经存在 - 但已注释掉）。

所以在原始代码中：

**reinterpret_cast<uint16_t**>

顺便说一下，始终在.OnAction中指定完全限定的宏名称。我通过艰苦的经历学到了这一点。确保始终将工作簿名称放在单引号中，就像我上面所说的那样。（引用并不总是需要，但通常都是......并且总是拥有它并没有什么坏处。）

然后在你的事件处理程序中：

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

Excel VBA Userform列表框动态上下文菜单使用.OnAction方法

1 个答案: