（2003版）右键三级菜单

335081548 · 发表于 2011-5-15 21:40

Sub 右键三级菜单()
On Error Resume Next '预防下面的删除菜单出错(当没有建立菜单的时候，没有菜单可删除就会出错）
Application.CommandBars("cell").Controls("我的右键").Delete '删除右键菜单，防止重复建立
'************************添加一级菜单
With Application.CommandBars("cell").Controls.Add(Type:=msoControlPopup, before:=1)
.Caption = "我的右键"
With .Controls.Add(Type:=msoControlPopup)
.Caption = "第一个一级菜单"
' 添加二级菜单第一个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单1" '标题
.FaceId = 71 '图标
.OnAction = "二级菜单1" '指定宏（或者说关联宏
End With
' 添加二级菜单第二个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单2"
.FaceId = 72
.OnAction = "二级菜单2"
End With
End With
' 添加一级菜单2
With .Controls.Add(Type:=msoControlButton)
.Caption = "第二个一级菜单"
.FaceId = 80
.OnAction = "第二个一级菜单"
.BeginGroup = True
End With
' 添加一级菜单3
With .Controls.Add(Type:=msoControlButton)
.Caption = "第三个一级菜单"
.FaceId = 81
.OnAction = "第三个一级菜单"
End With
'************************************
' 添加一级菜单4
With .Controls.Add(Type:=msoControlPopup)
.Caption = "第四个一级菜单"
' 第一个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单3"
.FaceId = 73
.OnAction = "二级菜单3"
End With
'添加第二个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单4"
.FaceId = 74
.OnAction = "二级菜单4"
End With
End With
'************************************
' 添加一级菜单5
With .Controls.Add(Type:=msoControlPopup)
.Caption = "第五个一级菜单"
' 第一个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单5"
.FaceId = 75
.OnAction = "二级菜单5"
End With
' 添加第二个快捷菜单项
With .Controls.Add(Type:=msoControlPopup)
.Caption = "二级菜单6"
' 添加三级菜单1
With .Controls.Add(Type:=msoControlButton)
.Caption = "三级菜单1"
.FaceId = 76
.OnAction = "三级菜单1"
End With
'添加三级菜单2
With .Controls.Add(Type:=msoControlButton)
.Caption = "三级菜单2"
.FaceId = 77
.OnAction = "三级菜单2"
End With
End With
End With
End With
End Sub
Sub 二级菜单1()
MsgBox "你按下了：二级菜单1"
End Sub
Sub 二级菜单2()
MsgBox "你按下了：二级菜单2"
End Sub
Sub 二级菜单3()
MsgBox "你按下了：二级菜单3"
End Sub
Sub 二级菜单4()
MsgBox "你按下了：二级菜单4"
End Sub
Sub 二级菜单5()
MsgBox "你按下了：二级菜单5"
End Sub
Sub 二级菜单6()
MsgBox "你按下了：二级菜单6"
End Sub
Sub 第二个一级菜单()
MsgBox "你按下了：第二个一级菜单"
End Sub
Sub 第三个一级菜单()
MsgBox "你按下了：第三个一级菜单"
End Sub
Sub 三级菜单1()
MsgBox "你按下了：三级菜单1"
End Sub
Sub 三级菜单2()
MsgBox "你按下了：三级菜单2"
End Sub
Sub DeleteTest() '删除右键菜单
On Error Resume Next
Application.CommandBars("cell").Controls("我的右键").Delete
End Sub
Sub 恢复右键()
Application.CommandBars("cell").Reset
End Sub

复制代码

335081548 · 发表于 2011-5-15 21:47

（2003版）菜单工具栏

Sub 工具栏三级菜单()
On Error Resume Next '预防下面的删除菜单出错(当没有建立菜单的时候，没有菜单可删除就会出错）
Application.CommandBars(1).Controls("我的菜单").Delete '删除菜单，防止重复建立
'************************添加一级菜单
With Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, before:=1)
.Caption = "我的菜单"
With .Controls.Add(Type:=msoControlPopup)
.Caption = "第一个一级菜单"
' 添加二级菜单第一个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单1" '标题
.FaceId = 71 '图标
.OnAction = "二级菜单1" '指定宏（或者说关联宏
End With
' 添加二级菜单第二个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单2"
.FaceId = 72
.OnAction = "二级菜单2"
End With
End With
' 添加一级菜单2
With .Controls.Add(Type:=msoControlButton)
.Caption = "第二个一级菜单"
.FaceId = 80
.OnAction = "第二个一级菜单"
.BeginGroup = True
End With
' 添加一级菜单3
With .Controls.Add(Type:=msoControlButton)
.Caption = "第三个一级菜单"
.FaceId = 81
.OnAction = "第三个一级菜单"
End With
'************************************
' 添加一级菜单4
With .Controls.Add(Type:=msoControlPopup)
.Caption = "第四个一级菜单"
' 第一个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单3"
.FaceId = 73
.OnAction = "二级菜单3"
End With
'添加第二个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单4"
.FaceId = 74
.OnAction = "二级菜单4"
End With
End With
'************************************
' 添加一级菜单5
With .Controls.Add(Type:=msoControlPopup)
.Caption = "第五个一级菜单"
' 第一个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单5"
.FaceId = 75
.OnAction = "二级菜单5"
End With
' 添加第二个快捷菜单项
With .Controls.Add(Type:=msoControlPopup)
.Caption = "二级菜单6"
' 添加三级菜单1
With .Controls.Add(Type:=msoControlButton)
.Caption = "三级菜单1"
.FaceId = 76
.OnAction = "三级菜单1"
End With
'添加三级菜单2
With .Controls.Add(Type:=msoControlButton)
.Caption = "三级菜单2"
.FaceId = 77
.OnAction = "三级菜单2"
End With
End With
End With
End With
End Sub
Sub 二级菜单1()
MsgBox "你按下了：二级菜单1"
End Sub
Sub 二级菜单2()
MsgBox "你按下了：二级菜单2"
End Sub
Sub 二级菜单3()
MsgBox "你按下了：二级菜单3"
End Sub
Sub 二级菜单4()
MsgBox "你按下了：二级菜单4"
End Sub
Sub 二级菜单5()
MsgBox "你按下了：二级菜单5"
End Sub
Sub 二级菜单6()
MsgBox "你按下了：二级菜单6"
End Sub
Sub 第二个一级菜单()
MsgBox "你按下了：第二个一级菜单"
End Sub
Sub 第三个一级菜单()
MsgBox "你按下了：第三个一级菜单"
End Sub
Sub 三级菜单1()
MsgBox "你按下了：三级菜单1"
End Sub
Sub 三级菜单2()
MsgBox "你按下了：三级菜单2"
End Sub
Sub DeleteTest() '删除菜单工具栏
On Error Resume Next
Application.CommandBars(1).Controls("我的菜单").Delete
End Sub
Sub 恢复右键()
Application.CommandBars("cell").Reset
End Sub

复制代码

335081548 · 发表于 2011-5-15 21:55

打造属于自己的右键

'把以下内容复制到相应的工作表中去
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'鼠标右键时执行的右键菜单
Application.CommandBars("test").ShowPopup
Cancel = True
End Sub

复制代码

插入一个模块输入如下代码：

Sub 打造属于自己的右键()
On Error Resume Next
Application.CommandBars("test").Delete '删除快捷菜单
'重新添加快捷菜单
With Application.CommandBars.Add(Name:="test", Position:=msoBarPopup)
'************************************
'添加一级菜单1
With .Controls.Add(Type:=msoControlPopup)
.Caption = "第一个一级菜单"
' 添加二级菜单第一个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单1" '标题
.FaceId = 71 '图标
.OnAction = "二级菜单1" '指定宏（或者说关联宏
End With
' 添加二级菜单第二个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单2"
.FaceId = 72
.OnAction = "二级菜单2"
End With
End With
' 添加一级菜单2
With .Controls.Add(Type:=msoControlButton)
.Caption = "第二个一级菜单"
.FaceId = 80
.OnAction = "第二个一级菜单"
.BeginGroup = True
End With
' 添加一级菜单3
With .Controls.Add(Type:=msoControlButton)
.Caption = "第三个一级菜单"
.FaceId = 81
.OnAction = "第三个一级菜单"
End With
'************************************
' 添加一级菜单4
With .Controls.Add(Type:=msoControlPopup)
.Caption = "第四个一级菜单"
' 第一个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单3"
.FaceId = 73
.OnAction = "二级菜单3"
End With
'添加第二个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单4"
.FaceId = 74
.OnAction = "二级菜单4"
End With
End With
'************************************
' 添加一级菜单5
With .Controls.Add(Type:=msoControlPopup)
.Caption = "第五个一级菜单"
' 第一个快捷菜单项
With .Controls.Add(Type:=msoControlButton)
.Caption = "二级菜单5"
.FaceId = 75
.OnAction = "二级菜单5"
End With
' 添加第二个快捷菜单项
With .Controls.Add(Type:=msoControlPopup)
.Caption = "二级菜单6"
' 添加三级菜单1
With .Controls.Add(Type:=msoControlButton)
.Caption = "三级菜单1"
.FaceId = 76
.OnAction = "三级菜单1"
End With
'添加三级菜单2
With .Controls.Add(Type:=msoControlButton)
.Caption = "三级菜单2"
.FaceId = 77
.OnAction = "三级菜单2"
End With
End With
End With
End With
End Sub
Sub 二级菜单1()
MsgBox "你按下了：二级菜单1"
End Sub
Sub 二级菜单2()
MsgBox "你按下了：二级菜单2"
End Sub
Sub 二级菜单3()
MsgBox "你按下了：二级菜单3"
End Sub
Sub 二级菜单4()
MsgBox "你按下了：二级菜单4"
End Sub
Sub 二级菜单5()
MsgBox "你按下了：二级菜单5"
End Sub
Sub 二级菜单6()
MsgBox "你按下了：二级菜单6"
End Sub
Sub 第二个一级菜单()
MsgBox "你按下了：第二个一级菜单"
End Sub
Sub 第三个一级菜单()
MsgBox "你按下了：第三个一级菜单"
End Sub
Sub 三级菜单1()
MsgBox "你按下了：三级菜单1"
End Sub
Sub 三级菜单2()
MsgBox "你按下了：三级菜单2"
End Sub

复制代码

dhf104109 · 发表于 2011-5-15 21:58

怎么用的啊？有什么用的？

dhf104109 · 发表于 2011-5-15 22:01

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'鼠标右键时执行的右键菜单
Application.CommandBars("test").ShowPopup
Cancel = True
End Sub

这句出现错误

huaimiao781 · 发表于 2011-5-15 22:03

楼主是做了个位置。
等大家把具体的功能代码嵌进去？

佛山小老鼠 · 发表于 2011-5-15 22:19

楼主的分享精神可贵，方便会员学习，送上鲜花5束，如果再补充一些代码说明就完美了！！！

335081548 · 发表于 2011-5-15 22:46

原帖由 dhf104109 于 2011-5-15 22:01 发表
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'鼠标右键时执行的右键菜单
Application.CommandBars("test").ShowPopup
Cancel = True
End Sub

这句出现错误

这个是Excel装了其他插件会引起的。例如：OfficeTab (多标签插件）也会引起的

换一种思路也可以，参照：
http://club.excelhome.net/viewth ... p;page=1#pid4882443
禁用EXCEL自带的右键菜单而改用自已右键菜单

[ 本帖最后由 335081548 于 2011-5-15 22:59 编辑 ]

335081548 · 发表于 2011-5-15 22:48

原帖由 佛山小老鼠 于 2011-5-15 22:19 发表
楼主的分享精神可贵，方便会员学习，送上鲜花5束，如果再补充一些代码说明就完美了！！！

都是跟着老师（你）学的

xmyjk · 发表于 2011-5-15 23:32

很不错的分享，谢谢楼主。

		自动登录	找回密码
密码			免费注册

[分享] （2003版）右键三级菜单

点评

评分

评分

回复 2楼 335081548 的帖子

回复 3楼 335081548 的帖子