vba活用excel右键菜单
仅在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分别指定宏,可实现禁用与启用。
-------------------
高级自定义右键菜单项