【コピペでOK！】右クリックメニューを追加/無効するマクロ

Private Const メニュー名 As String = "メニュー"      '※1 好きなメニュー名に書き換える

Public Sub 右クリックメニュー追加()
    Dim cb As CommandBar

    For Each cb In CommandBars
        If cb.BuiltIn = True And cb.Name = "Cell" Then
            On Error Resume Next
            cb.Controls(メニュー名).Delete
            With cb.Controls.Add(before:=1, Type:=msoControlButton)　'before:= 表示位置
                .Caption = メニュー名
                .OnAction = "デモ1"        '実行するプロシージャを指定
            End With
        End If
    Next cb
End Sub

Public Sub 追加メニュー削除()
Dim cb As CommandBar
    For Each cb In CommandBars
        If cb.BuiltIn = True And cb.Name = "Cell" Then
            On Error Resume Next
            cb.Controls(メニュー名).Delete
        End If
    Next cb
End Sub

Private Sub デモ1()
MsgBox "嫌な予感がする"
End Sub

Private Const シート名 As String = "Sheet1"     '※1 有効にするシートのオブジェクト名

Private Sub Workbook_Open()
    Select Case ActiveSheet.CodeName
    Case シート名
        call 右クリックメニュー追加
    End Select
End Sub

Private Sub Workbook_Deactivate()
    call 追加メニュー削除
End Sub

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Select Case sh.CodeName
    Case シート名
        call 右クリックメニュー追加
    Case Else
        call 追加メニュー削除
    End Select
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   call 追加メニュー削除
End Sub

Public Sub 右クリックメニュー追加()
    Dim cb As CommandBar

    For Each cb In Application.CommandBars
        If cb.BuiltIn = True And cb.Name = "Cell" Then
            On Error Resume Next
            cb.Controls(メニュー名).Delete
            With cb.Controls.Add(before:=1, Type:=msoControlPopup)      'Type名 msoControlPopup へ変更
                .Caption = メニュー名
                With .Controls.Add
                    .Caption = "サブメニュー1"      'サブメニュー名
                    .OnAction = "デモ1"
                End With
                With .Controls.Add
                    .Caption = "サブメニュー2"      'サブメニュー名
                    .OnAction = "デモ2"
                End With
            End With
        End If
    Next cb
End Sub

Public Sub 追加メニュー削除()
Dim cb As CommandBar
    For Each cb In CommandBars
        If cb.BuiltIn = True And cb.Name = "Cell" Then
            On Error Resume Next
            cb.Controls(メニュー名).Delete
        End If
    Next cb
End Sub

Private Sub デモ1()
MsgBox "嫌な予感がする"
End Sub

Private Sub デモ2()
MsgBox "いい予感しかしないぜ"
End Sub

Private Const シート名1 As String = "Sheet1"
Private Const シート名2 As String = "Sheet2"    '追加

Private Sub Workbook_Open()
    Select Case ActiveSheet.CodeName
    Case シート名1, シート名2    '追加
        call 右クリックメニュー追加
    End Select
End Sub

Private Sub Workbook_Deactivate()
    call 追加メニュー削除
End Sub

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Select Case sh.CodeName
    Case シート名1, シート名2    '追加
        call 右クリックメニュー追加
    Case Else
        On Error Resume Next
        call 追加メニュー削除
    End Select
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   call 追加メニュー削除
End Sub

Private Sub Workbook_Open()
    call 右クリックメニュー追加
End Sub

Private Sub Workbook_Activate()
    call 右クリックメニュー追加
End Sub

Private Sub Workbook_Deactivate()
    call 追加メニュー削除
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   call 追加メニュー削除
End Sub

Private Sub Workbook_Open()
    Call 右クリック無効(False)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call 右クリック無効(True)
End Sub

Sub 右クリック無効(flg As Boolean)
    Dim r As Variant
    Dim 無効メニュー As Variant
    
    無効メニュー = Array(1, 2, 4, 6, 9, 10, 11, 12, 13, 15, 16, 17, 21, 22, 23, 24)
    
    For Each r In 無効メニュー
        Application.CommandBars("Cell").Controls(r).Enabled = flg
    Next r
End Sub

Sub 右クリック無効(flg As Boolean)
    Application.CommandBars("Cell").Enabled = flg
End Sub