「追加したはずの右クリックメニューが表示されない事件」の真相 ④

先日来、２年越しの事件が解決しそうだ。
infoment.hatenablog.com

今日は前日までの内容のうち、メニュー追加までを纏めてみる。

何とかの一つ覚え、今回もクラスモジュールにまとめてみた。

クラスモジュール（RightClickCommand）

今回の作戦は、こんな感じだ。

1. 各コマンドバーの番号は、数字だけでは判別しえないので定数にしておく。
2. 上記定数を「初期設定配列」に格納し、ユーザーが毎回していしなくとも、
   大体使いそうなコマンドバーに一括設定できるようにする
   （ただし任意に上書き可能）。
3. 同じコマンドが幾つも追加されないよう、有無確認関数を作成。
4. 個別のコマンドバーに追加する機能を準備し、各コマンドバーのループから
   取り出すことで個別設定も可能とする。

以上を踏まえて作成したのが、こちら。

Option Explicit

' 「改プ」は改ページプレビューの意
Const cb標準_Range As Long = 38
Const cb改プ_Range As Long = 41
Const cb標準_PivotTable As Long = 61
Const cb標準_ListObject As Long = 74
Const cb改プ_ListObject As Long = 75

Public TargetArray As Variant
Dim LoopIndex As Variant
Dim i As Long

Private Property Get DefaultArray() As Variant
    ' 右クリックメニューを設定するCommandBarの
    ' インデックスを集めた配列。
    Dim arr As Variant
        arr = Array(cb標準_Range, _
                    cb改プ_Range, _
                    cb標準_PivotTable, _
                    cb標準_ListObject, _
                    cb改プ_ListObject)
        DefaultArray = arr
End Property

Private Sub Class_Initialize()
    ' メニューを追加するCommandBarの初期設定。
    ' ※上書きで任意に変更可。
    TargetArray = DefaultArray
End Sub

' 追加予定のメニュー名存在確認。
Private Function DuplicateFlag(name_to_add As String, _
                               commandbar_index As Long) As Boolean
    
    ' 追加予定の名前が存在する場合、Trueを返す。
    With Application.CommandBars(commandbar_index)
        For i = .Controls.Count To 1 Step -1
            If .Controls.Item(i).Caption = name_to_add Then
                DuplicateFlag = True
                Exit Function
            End If
        Next
    End With
    
End Function

' 指定CommandBarへ指定メニュー追加。
Public Sub AddMenuToSpecifiedCommandBar(name_to_add As String, _
                                        action_to_add As String, _
                                        commandbar_index As Long)
            
    ' 追加予定のメニューが無い場合に限り、追加処理を行う。
    ' ※同名の右クリックメニューが存在する場合、既存優先とする。
    If Not DuplicateFlag(name_to_add, commandbar_index) Then
        With Application.CommandBars(commandbar_index).Controls.Add
            .Caption = name_to_add
            .OnAction = action_to_add
        End With
    End If
    
End Sub

' 各CommandBarへ指定メニュー追加。
Public Sub AddMenu(name_to_add As String, _
                   action_to_add As String)
    
    For Each LoopIndex In TargetArray
        AddMenuToSpecifiedCommandBar name_to_add, _
                                     action_to_add, _
                                     CLng(LoopIndex)
    Next
    
End Sub

標準モジュール

それでは、早速テストしてみよう。
右クリックメニューに追加するのは、こちらのサブプロシージャ。

Sub Hoge()
    MsgBox "ほげ"
End Sub

これを、個別に追加してみる。

Sub Test()
    With New RightClickCommand
        .AddMenuToSpecifiedCommandBar "ホゲ", "Hoge", 38
        .AddMenuToSpecifiedCommandBar "ホげ", "Hoge", 74
        .AddMenuToSpecifiedCommandBar "ほげ", "Hoge", 61
    End With
End Sub

結果、それぞれ別の右クリックメニューに追加することが出来た。

また、↓ こちらの場合は、複数を追加することができた。

Sub Test2()
    With New RightClickCommand
        .AddMenu "ホゲ", "Hoge"
        .AddMenu "ホげ", "Hoge"
        .AddMenu "ほげ", "Hoge"
    End With
End Sub

これで、半分が出来た。

次回は、もう半分（消す方）に挑戦です。

参考まで。