VBA用户窗体中的鼠标右键菜单

时间:2018-07-20 08:10:02

标签: excel vba excel-vba word-vba userform

我有一个用户窗体列表框,其中填充了数据库的搜索结果。根据您搜索人民币的内容,单击应提供不同的菜单。如果我搜索项目,则RMB菜单将是New Project,Information等。如果我搜索文档,RMB菜单应是New File,Information .....

如所见,菜单中确实有很多相同的菜单项,所以我的想法是用菜单标签和触发方法将所有的人民币菜单项制作成字典:

  1. “新项目”,Project.NewProject
  2. “新文件”,File.newFile
  3. “信息”,CustomProperties.information

.......

现在的实际代码是

处理菜单的类模块:

Option Explicit

Public LBox As MSForms.ListBox
Public WithEvents ContextMenu_Command As CommandBarButton


Private Sub ContextMenu_Command_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)

    Call RMBMenus.callBackRMBMenus(Ctrl.caption)

End Sub

我的模块创建菜单以及回调。

Option Explicit
Public Const mCONTEXT_MENU_NAME = "myRightClickListbox"
Private m_clsContextMenu As CContextMenu
Public Sub callBackRMBMenus(captionText As String)
    Select Case captionText

        Case "NEW FILE"
            Call initGUI.initGUI("NEW FILE")

            GUI.NewDocument_ComboBox_ProjectNumber.listIndex = 5

        Case Else

    End Select
End Sub

Public Sub addRMBMenu(typeDef As String)
    Dim cmd As Variant


    ' remove any previous instance
    On Error Resume Next
    Application.CommandBars(mCONTEXT_MENU_NAME).Delete
    On Error GoTo 0

    Set m_clsContextMenu = New CContextMenu

    With CommandBars.Add(mCONTEXT_MENU_NAME, Position:=msoBarPopup)

    Select Case typeDef 

        Case "P:"
        .Controls.Add(Type:=msoControlButton).caption = "New File"
        .Controls.Add(Type:=msoControlButton).caption = "New From Selected File"
        .Controls.Add(Type:=msoControlButton).caption = "Change status"
        .Controls.Add(Type:=msoControlButton).caption = "Open editable file"
        .Controls.Add(Type:=msoControlButton).caption = "Open PDF of file"
        .Controls.Add(Type:=msoControlButton).caption = "Publish File"
        .Controls.Add(Type:=msoControlButton).caption = "Change properties of file"
        .Controls.Add(Type:=msoControlButton).caption = "Delete file"

         Case else
   End Select
        'here it fails...
        For Each cmd In .Controls
            Set m_clsContextMenu.ContextMenu_Command = cmd
        Next
        Set m_clsContextMenu.LBox = GUI.Search_ListBox
    End With
End Sub

它仅按预期方式注册最后一个菜单项,但是如何重写以执行所有菜单项?还是我的方法完全不适合人民币菜单?

0 个答案:

没有答案