VBA通用代码：在Excel中创建弹出菜单

Public Const Mname As String ="MyPopUpMenu"
Sub DeletePopUpMenu()
    ' 如果该弹出菜单已存在则删除.
   On Error Resume Next
   Application.CommandBars(Mname).Delete
   On Error GoTo 0
End Sub
Sub CreateDisplayPopUpMenu()
    ' 删除已存在的弹出菜单.
   Call DeletePopUpMenu
    ' 创建弹出菜单.
   Call Custom_PopUpMenu_1
    ' 显示弹出菜单.
   On Error Resume Next
   Application.CommandBars(Mname).ShowPopup
   On Error GoTo 0
End Sub
Sub Custom_PopUpMenu_1()
   Dim MenuItem As CommandBarPopup
    ' 添加弹出菜单.
   With Application.CommandBars.Add(Name:=Mname, _
         Position:=msoBarPopup, _
         MenuBar:=False, Temporary:=True)
        ' 首先, 在菜单中添加两个按钮.
        With.Controls.Add(Type:=msoControlButton)
            .Caption = "按钮1"
            .FaceId = 71
            .OnAction = "'" &ThisWorkbook.Name & "'!" & "TestMacro"
        End With
        With.Controls.Add(Type:=msoControlButton)
            .Caption = "按钮2"
            .FaceId = 72
            .OnAction = "'" &ThisWorkbook.Name & "'!" & "TestMacro"
        End With
        ' 接着, 添加包含两个按钮的菜单.
        Set MenuItem =.Controls.Add(Type:=msoControlPopup)
        With MenuItem
            .Caption = "我的特定菜单"
            With.Controls.Add(Type:=msoControlButton)
                .Caption = "菜单中的按钮 1"
                .FaceId = 71
                .OnAction = "'" &ThisWorkbook.Name & "'!" & "TestMacro"
            End With
            With.Controls.Add(Type:=msoControlButton)
                .Caption = "菜单中的按钮2"
                .FaceId = 72
                .OnAction = "'" &ThisWorkbook.Name & "'!" & "TestMacro"
            End With
        End With
        ' 最后, 添加单个按钮.
        With.Controls.Add(Type:=msoControlButton)
            .Caption = "按钮3"
            .FaceId = 73
            .OnAction = "'" &ThisWorkbook.Name & "'!" & "TestMacro"
        End With
   End With
End Sub
Sub TestMacro()
   MsgBox "Hello! 成功啦!"
End Sub