vba活用excel右鍵菜單

vbavsto 2021-04-13

展開全文

僅在a列出現(xiàn)數(shù)據(jù)菜單：

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("經(jīng)理室", "辦公室", "生技科", "財務(wù)科", "營業(yè)部")
    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分別指定宏，可實現(xiàn)禁用與啟用。