【初心者でもOK！】マクロで右クリックメニューを追加するVBAコード

Sub Sample1() 'マクロ名
    With CommandBars("Cell").Controls.Add(Type:=msoControlButton) '右クリックメニューを追加
        .Caption = "Button" '追加するメニューの名前
        .OnAction = "myMacro" 'メニューを押した時に実行されるマクロ名
    End With
End Sub

Sub myMacro() 'マクロ名
    MsgBox "Hello" 'メッセージボックスに「Hello」と表示される
End Sub

Sub Sample2() 'マクロ名
    CommandBars("Cell").Controls("Button").Delete '追加したメニューを削除する
End Sub

'///////モジュール///////
'*******プロシージャ始まり*******
Sub Sample1()    'ステートメント
    With CommandBars("Cell").Controls.Add(Type:=msoControlButton)    'ステートメント
        .Caption = "Button"    'ステートメント
        .OnAction = "myMacro"    'ステートメント
    End With    'ステートメント
End Sub    'ステートメント
'*******プロシージャ終わり*******

'*******プロシージャ始まり*******
Sub myMacro()    'ステートメント
    MsgBox "Hello"    'ステートメント
End Sub    'ステートメント
'*******プロシージャ終わり*******

'*******プロシージャ始まり*******
Sub Sample2()    'ステートメント
    CommandBars("Cell").Controls("Button").Delete    'ステートメント
End Sub    'ステートメント
'*******プロシージャ終わり*******

Sub 右クリックメニュー追加() 
'Before:= で表示位置（行）、Type:= でコントロールの種類を設定
    With CommandBars("Cell").Controls.Add(Before:=1, Type:=msoControlPopup)
        .Caption = "無限列車編"
            With .Controls.Add 'サブメニューを追加
                 .Caption = "セリフ1" 'サブメニュー(1段目)の名前
                 .OnAction = "台詞1"
            End With
            With .Controls.Add
                 .Caption = "セリフ2" 'サブメニュー(2段目)の名前
                 .OnAction = "台詞2"
            End With
    End With
End Sub

Sub 台詞1()
    MsgBox "柱として不甲斐なし"
End Sub

Sub 台詞2()
    MsgBox "穴があったら入りたい"
End Sub

Sub メニュー削除()
    CommandBars("Cell").Controls("無限列車編").Delete
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)'右クリック（の直前）でイベント開始
'右クリックメニュー追加をここに貼り付け
    With CommandBars("Cell").Controls.Add(Before:=1, Type:=msoControlPopup)
        .Caption = "無限列車編"
            With .Controls.Add 'サブメニューを追加
                 .Caption = "セリフ1" 'サブメニュー(1段目)の名前
                 .OnAction = "台詞1"
            End With
            With .Controls.Add
                 .Caption = "セリフ2" 'サブメニュー(2段目)の名前
                 .OnAction = "台詞2"
            End With
    End With
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    CommandBars("Cell").Controls("Button").Delete '[メニュー削除]をここに貼り付け
    With CommandBars("Cell").Controls.Add(Before:=1, Type:=msoControlPopup)
        .Caption = "無限列車編"
        With .Controls.Add
            .Caption = "セリフ1"
            .OnAction = "台詞1"
        End With
        With .Controls.Add
            .Caption = "セリフ2"
            .OnAction = "台詞2"
        End With
    End With
End Sub

Sub 台詞1()
    MsgBox "柱として不甲斐なし"
End Sub

Sub 台詞2()
    MsgBox "穴があったら入りたい"
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'エラーが出たら次の処理へスキップ
    On Error Resume Next
'ここがエラーになったら
    CommandBars("Cell").Controls("無限列車編").Delete
'ここまでスキップしてくれる
    With CommandBars("Cell").Controls.Add(Before:=1, Type:=msoControlPopup)
        .Caption = "無限列車編"
        With .Controls.Add
            .Caption = "セリフ1"
            .OnAction = "台詞1"
        End With
        With .Controls.Add
            .Caption = "セリフ2"
            .OnAction = "台詞2"
        End With
    End With
End Sub

Private Sub Worksheet_Deactivate() 'ワークシートがアクティブでなくなった時にイベント発生
    On Error Resume Next
    CommandBars("Cell").Controls("無限列車編").Delete
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean) 'ブックが閉じる時にイベントが発生
    On Error Resume Next
    Application.CommandBars("Cell").Controls("無限列車編").Delete
End Sub

Private Sub Workbook_Deactivate() 'ブックがアクティブでなくなった時にイベント発生
    On Error Resume Next
    Application.CommandBars("Cell").Controls("無限列車編").Delete
End Sub