EXCEL利用VBA增加鼠标右键菜单

laoda1228

Sub CellMune()
'预防下面的删除菜单出错(当没有建立菜单的时候，没有菜单可删除就会出错）
    On Error Resume Next
    '删除右键菜单，防止重复建立
    Application.CommandBars("Cell").Controls("人员调整").Delete
    Application.CommandBars("Cell").Controls("分类排序").Delete
    Application.CommandBars("Cell").Controls("查询").Delete
    Application.CommandBars("Cell").Controls("打印选定内容").Delete

    '添加菜单
     With Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=1)
        .Caption = "人员调整"
        '添加二级菜单1 调离
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "调离"  '标题
            .FaceId = 80       '图标
            .OnAction = "调离"  '指定宏（或者说关联宏)
        End With
        '添加二级菜单2 退休
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "退休"
            .FaceId = 81
            .OnAction = "退休"
        End With
        '添加二级菜单3 辞职
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "辞职"
            .FaceId = 82
            .OnAction = "辞职"
        End With
        '添加二级菜单4 内退
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "内退"
            .FaceId = 83
            .OnAction = "内退"
        End With
    End With

    With Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, before:=2)
        .Caption = "分类排序"
        '添加二级菜单1 年龄排序
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "年龄排序"  '标题
            .FaceId = 80       '图标
            .OnAction = "年龄排序"  '指定宏（或者说关联宏)
        End With
        '添加二级菜单2 科室排序
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "科室排序"
            .FaceId = 81
            .OnAction = "科室排序"
        End With
        '添加二级菜单3 职称排序
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "职称排序"
            .FaceId = 82
            .OnAction = "职称排序"
        End With
    End With

    With Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, before:=3)
        .Caption = "查询"
        .FaceId = 255
        .OnAction = "查询"
    End With

    With Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, before:=4)
        .Caption = "打印选定内容"
        .FaceId = 256
        .OnAction = "打印选定内容"
    End With

End Sub

Sub DeleteCell()    '删除右键菜单
    On Error Resume Next
    Application.CommandBars("Cell").Controls("人员调整").Delete
    Application.CommandBars("Cell").Controls("分类排序").Delete
    Application.CommandBars("Cell").Controls("查询").Delete
    Application.CommandBars("Cell").Controls("打印选定内容").Delete
End Sub

Sub CellReset()
'恢复右键
    Application.CommandBars("Cell").Reset
End Sub




'------第一种方案------
Private Sub Workbook_Open()
'文件打开时执行程序
'文件启动时创建菜单
    Call CellMune
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'关闭文件时执行程序
'文件关闭时进行菜单复位（删除）
    Call CellReset
End Sub
'------以上内容如果想只在总人数表出现菜单可以删除------

'------第二种方案------
'------想每个工作表都调用菜单删除以下程序即可------
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'工作表激活时执行程序
    If ActiveSheet.Name = "总人数" Then    '如果激活的工作表名为"总人数" 就
        Call CellMune       'Call 创建右键菜单的宏
    Else                    '否则
        Call CellReset      'Call 右键菜单复位的宏
    End If
End Sub

cuirencui

呵呵，谢谢，收藏了！

ggxx123123

能不能在编辑的状态下，添加右键菜单。

laoda1228

我什么时候发过这 帖子，好难得

旺小东

代码分别放在哪里呀？？？？？？？？？

xsm1974

好东东啊，先收藏着。