Excel VBA - 将子菜单添加到自定义右键单击菜单

Day*_*.01 6 excel vba

长时间观看,第一次海报.我有一个右键单击功能的表单,工作正常.我正在尝试在主右键菜单中添加子菜单以分隔一些函数/命令.我需要/想要插入"选择案例"所在的部分,但是,它只显示顶部菜单.不知道从哪里开始.任何帮助都是极好的

谢谢 :)

PS如果需要,我很乐意进一步解释.

Sub fzCopyPaste(iItems As Integer)
On Error Resume Next
CommandBars("Custom").Delete
Set PopBar = CommandBars.Add(Name:="Custom", Position:=msoBarPopup, MenuBar:=False, Temporary:=True)
Run Code Online (Sandbox Code Playgroud)

'在主Popbar上添加top_menu:这很好

Set top_menu = PopBar.Controls.Add(Type:=msoControlButton)
With top_menu
    '.FaceId =
    .Caption = "&Some Commands"
End With
Run Code Online (Sandbox Code Playgroud)

需要将以下子菜单插入顶部菜单但没有显示:不起作用

Select Case iItems
Case 1  ' Copy and Paste
    Set copy_button = top_menu.Controls.Add(Type:=msoControlButton)
    With copy_button
        .FaceId = 19
        .Caption = "&Copy"
        .Tag = "tCopy"
        .OnAction = "fzCopyOne(true)"
    End With

    Set paste_button = top_menu.Controls.Add(Type:=msoControlButton)
    With paste_button
        .FaceId = 22
        .Tag = "tPaste"
        .Caption = "&Paste"
        .OnAction = "fzCopyOne(true)"
    End With
Case 2 '  Paste Only
    Set paste_button = top_menu.Controls.Add(Type:=msoControlButton)
    With paste_button
        .FaceId = 22
        .Tag = "tPaste"
        .Caption = "&Paste"
        .OnAction = "fzCopyOne(true)"
    End With
End Select
Run Code Online (Sandbox Code Playgroud)

'这里有额外的顶级菜单:这个工作正常

    Set paste_button = PopBar.Controls.Add(Type:=msoControlButton)
    With paste_button
        .FaceId = 22
        .Tag = "tPaste"
        .Caption = "Main POP BAR 2"
        .OnAction = "fzCopyOne(true)"
    End With


PopBar.ShowPopup

CommandBars("Custom").Delete
End Sub
Run Code Online (Sandbox Code Playgroud)

Tim*_*Tim 3

您设置Copy_Button等于msoControlButton. 如果你想要一个按钮,这是正确的。但您想要一个菜单​​,因此您应该将其设置为msoControlPopup. 尝试这样的事情:

\n\n
Set Top_Menu = PopBar.Controls.Add(Type:=msoControlPopup)\nWith Top_Menu \n    .Caption = "&Some Commands"\n    Set MySubMenu = .Controls.Add(Type:=msoControlPopup, before:=1, temporary:=True)\n    Select Case iItems\n        Case 1\n            With MySubMenu\n                .Caption = "Submenu Commands"\n                With .Controls.Add(Type:=msoControlButton, before:=1, temporary:=True)\n                    .FaceId = 19\n                    .Caption = "&Copy"\n                    .Tag = "tCopy"\n                    .OnAction = "fzCopyOne(true)"\n                End With\n\n                With .Controls.Add(Type:=msoControlButton, before:=2, temporary:=True)\n                    .FaceId = 22\n                    .Tag = "tPaste"\n                    .Caption = "&Paste"\n                    .OnAction = "fzCopyOne(true)"\n                End With\n            End With\n        Case 2\n            \'etc\n    End Select\nEnd With\n
Run Code Online (Sandbox Code Playgroud)\n\n

我删除了 \xe2\x80\x9cTop_Menu\xe2\x80\x9d 部分(前 3 行),如下所示;它添加了一个额外的按钮,然后添加了所需的菜单。

\n\n
Set MySubMenu = PopBar.Controls.Add(Type:=msoControlPopup, before:=1, temporary:=True)\nWith MySubMenu\n    .Caption = "&Some Commands"\n
Run Code Online (Sandbox Code Playgroud)\n