仅在a列出现数据菜单:
thisworkbook代码:
Option Explicit Private Sub Workbook_Deactivate() Call DeleteMycell End Sub sheet1 代码:
Option Explicit Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 1 Then Call Mycell Application.CommandBars("Mycell").ShowPopup Cancel = True End If End Sub
新建立模块代码:
Option Explicit Sub Mycell() Dim arr As Variant Dim i As Integer Dim Mycell As CommandBar On Error Resume Next Application.CommandBars("Mycell").Delete arr = Array("经理室", "办公室", "生技科", "财务科", "营业部") Set Mycell = Application.CommandBars.Add("Mycell", 5) For i = 0 To 4 With Mycell.Controls.Add(1) .Caption = arr(i) .OnAction = "MyOnAction" End With Next End Sub Sub MyOnAction() ActiveCell = Application.CommandBars.ActionControl.Caption End Sub Sub DeleteMycell() On Error Resume Next Application.CommandBars("Mycell").Delete End Sub
---------------------
改变整个右键菜单代码:
thisbook里:
Option Explicit Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Application.CommandBars("Mycell").ShowPopup Cancel = True End Sub
sheet1里:
Option Explicit Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Application.CommandBars("Mycell").ShowPopup Cancel = True End Sub
新建模块里:
Option Explicit Sub Mycell() With Application.CommandBars.Add("Mycell", msoBarPopup) With .Controls.Add(Type:=msoControlButton) .Caption = "会计凭证" .FaceId = 9893 End With With .Controls.Add(Type:=msoControlButton) .Caption = "会计账簿" .FaceId = 284 End With With .Controls.Add(Type:=msoControlPopup) .Caption = "会计报表" With .Controls.Add(Type:=msoControlButton) .Caption = "月报" .FaceId = 9590 End With With .Controls.Add(Type:=msoControlButton) .Caption = "季报" .FaceId = 9591 End With With .Controls.Add(Type:=msoControlButton) .Caption = "年报" .FaceId = 9592 End With End With With .Controls.Add(Type:=msoControlButton) .Caption = "凭证打印" .FaceId = 9614 .BeginGroup = True End With With .Controls.Add(Type:=msoControlButton) .Caption = "账簿打印" .FaceId = 707 End With With .Controls.Add(Type:=msoControlButton) .Caption = "报表打印" .FaceId = 986 End With End With End Sub Sub DeleteMycell() On Error Resume Next Application.CommandBars("Mycell").Delete End Sub
其他的sheet里:
Option Explicit
-------------------
禁用鼠标右键:
thisworkbook里:
Option Explicit Private Sub Workbook_Deactivate() Call EnaBar End Sub
新建模块:
Option Explicit Sub DisBar() Dim myBar As CommandBar For Each myBar In CommandBars If myBar.Type = msoBarTypePopup Then myBar.Enabled = False End If Next End Sub Sub EnaBar() Dim myBar As CommandBar For Each myBar In CommandBars If myBar.Type = msoBarTypePopup Then myBar.Enabled = True End If Next End Sub 在sheet中定义2个command分别指定宏,可实现禁用与启用。
-------------------
高级自定义右键菜单项
|