[Excel]VBAで「右クリックメニュー」を追加する その2

VBAサンプル

VBAさわり始めの頃に同様のコードを書いたのですが、あれこれ手を入れて今は以下のコードを使っています。右クリックメニューを追加したい方はコピペして使ってみて下さい。

特定のシートで右クリックメニューを追加

定数(Const)にメニュー名とオブジェクト名を設定する

  • 標準モジュールの定数に「追加するメニューの名前」を入力
  • Bookモジュールの定数に追加メニューを有効にするシートの「オブジェクト名」を入力
標準モジュール

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

Public Sub AddRightclickmenu()
    Dim mycb As CommandBar

    For Each mycb In Application.CommandBars
        If mycb.BuiltIn = True And mycb.Name = "Cell" Then
            On Error Resume Next
            mycb.Controls(menuname).Delete
            With mycb.Controls.Add(before:=1, Type:=msoControlButton)
                .Caption = menuname
                .OnAction = "Macro1"        '実行するプロシージャを指定
            End With
        End If
    Next mycb
End Sub

Public Sub DeleteMenu()
    On Error Resume Next
    Application.CommandBars("Cell").Controls(menuname).Delete
End Sub

Private Sub Macro1()
MsgBox "Hello"
End Sub
Bookモジュール(ThisWorkBook)


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

Private Sub Workbook_Open()
    Select Case ActiveSheet.CodeName
    Case obj1
        call AddRightclickmenu
    End Select
End Sub

Private Sub Workbook_Deactivate()
    call DeleteMenu
End Sub

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Select Case sh.CodeName
    Case obj1
        call AddRightclickmenu
    Case Else
        call DeleteMenu
    End Select
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   call DeleteMenu
End Sub

Application.CommandBars と冗長的な書き方をしているのはBookモジュール内で Application. を省略するとエラーになる(Bookモジュール内ではオブジェクトを省略するとThisworkbook. を参照する)のでコードの揺れが無いように統一しているからです。標準モジュール内では省略してもちゃんと動きます。

シートをオブジェクト名で参照しているのはシート名が変わってもマクロを機能させるためです。オブジェクト名ではなくシート名で指定したい方は[ Code.Name ]の部分を[ .Name ]に変更して下さい。

このコードは追加メニューを右クリックメニューの一番上に表示します。表示位置を変更したい方、サブメニュー(2段階)を追加したい方は以下の記事の「メニューの表示位置とサブメニューの追加」をご覧下さい。メニューそのものの数を増やしたい方も以下記事で解決できます。蛇足ですが、このコードは改ページプレビューでも追加メニューが機能します。その解説も以下記事の最後ら辺りで紹介しています。

他のシートでも追加右クリックメニューを有効にする

Bookモジュールの定数と Select Case ステートメントの引数を追加して下さい(Case の引数は「,」区切りで)。

Bookモジュール_Sheet2追加

Private Const obj1 As String = "Sheet1"
Private Const obj2 As String = "Sheet2"    '追加

Private Sub Workbook_Open()
    Select Case ActiveSheet.CodeName
    Case obj1, obj2    '追加
        call AddRightclickmenu
    End Select
End Sub

Private Sub Workbook_Deactivate()
    On Error Resume Next
    Application.CommandBars("Cell").Controls(menuname).Delete
End Sub

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Select Case sh.CodeName
    Case obj1, obj2    '追加
        call AddRightclickmenu
    Case Else
        On Error Resume Next
        call Application.CommandBars("Cell").Controls(menuname).Delete
    End Select
End Sub

全シートで右クリックメニューを追加

標準モジュールは前述のものをそのまま、Book モジュールを以下のようにすれば、ファイルを開いた時から閉じるまで全てのシートで追加メニューが有効になります。別のブックがアクティブの時は無効になります。

Bookモジュール_全シートで追加メニュー有効

Private Sub Workbook_Open()
    call AddRightclickmenu
End Sub

Private Sub Workbook_Activate()
    call AddRightclickmenu
End Sub

Private Sub Workbook_Deactivate()
    call DeleteMenu
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   call DeleteMenu
End Sub

あとがき

前回書いたときとの差を備忘で残します。

Sheetモジュールへの記述をやめた

前回はSheetモジュールの Worksheet_BeforRightClickイベントを利用していました。追加するメニューが右クリックメニューだからといって、トリガーを右クリックにする必要はありません。当時は気が付けませんでしたが…

また、Worksheet_Activate イベントから Workbook_SheetActivate イベントへ変更しました。Workbook_SheetActivate イベントは引数 Sh にアクティブシートが渡されるので、複数シートで同じ処理をするのならこっちを使った方が便利です。

結果、Sheetモジュールの記述がなくなることによって、シートを増やす度にプロシージャをコピペする無駄が無くなりました。

最後までご高覧いただき、ありがとうございました。

タイトルとURLをコピーしました