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

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

今日は、今回のシリーズのまとめ、最終回。
f:id:Infoment:20200805222736p:plain

今回新調した、右クリックメニュー追加用クラスモジュール。
自宅で試して限り上手く行ったのに、職場では期待通りの動作に
ならなかった。どうして？

色々調べて分かったこと。それは、Excelのバージョンによって、
例えば同じ「List Range Popup」でも、Indexが異なるということ。
番号で指定していたため、完全に見当違いのところに追加していた
わけで。

ということで、各定数を番号ではなく名前に置き換えることにした。
これなら、番号のずれがあっても対応できると考えたからだ。

【変更前】

    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

【変更後】

    Const cb標準_Range As String = "Cell"
    Const cb改プ_Range As String = "Cell"
    Const cb標準_PivotTable As String = "PivotTable Context Menu"
    Const cb標準_ListObject As String = "List Range Popup"
    Const cb改プ_ListObject As String = "List Range Layout Popup"

　
最終的な成果物がこちら。

クラスモジュール（RightClickComman）

Option Explicit

    ' 「改プ」は改ページプレビューの意
    Const cb標準_Range As String = "Cell"
    Const cb改プ_Range As String = "Cell"
    Const cb標準_PivotTable As String = "PivotTable Context Menu"
    Const cb標準_ListObject As String = "List Range Popup"
    Const cb改プ_ListObject As String = "List Range Layout Popup"
    
    Dim TargetArray As Variant
    Dim LoopIndex As Variant
    Dim i As Long

Private Property Get DefaultArray() As Variant
    ' 右クリックメニューを設定するCommandBarの
    ' インデックスを集めた配列。
    Dim arr As Variant
        arr = Array()
        For i = 1 To Application.CommandBars.Count
            Select Case Application.CommandBars(i).Name
                Case cb標準_Range, _
                     cb改プ_Range, _
                     cb標準_PivotTable, _
                     cb標準_ListObject, _
                     cb改プ_ListObject
                    
                    ReDim Preserve arr(UBound(arr) + 1)
                    arr(UBound(arr)) = i
            End Select
        Next
            
        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, _
                               Optional begin_group As Boolean = False)
            
    ' 追加予定のメニューが無い場合に限り、追加処理を行う。
    ' ※同名の右クリックメニューが存在する場合、既存優先とする。
    If Not DuplicateFlag(name_to_add, commandbar_index) Then
        With Application.CommandBars(commandbar_index).Controls.Add
            .Caption = name_to_add
            .OnAction = action_to_add
            .BeginGroup = begin_group
        End With
    End If
    
End Sub

' 各CommandBarへ指定メニュー追加。
Public Sub AddMenu(name_to_add As String, _
                   action_to_add As String, _
          Optional begin_group As Boolean = False)

    
    For Each LoopIndex In TargetArray
        AddMenuToSpecifiedCommandBar name_to_add, _
                                     action_to_add, _
                                     CLng(LoopIndex), _
                                     begin_group
    Next
    
End Sub

' 指定CommandBarから指定メニュー削除。
Public Sub DelMenuFromSpecifiedCommandBar(name_to_del As String, _
                                          commandbar_index As Long)
        
    ' 指定メニューが存在する場合のみ、それを削除する。
    ' ※既存の標準メニューも消せるため注意。
    ' ※DuplicateFlagのiを、そのまま削除に用いる。
    If DuplicateFlag(name_to_del, commandbar_index) Then
        Application.CommandBars(commandbar_index).Controls.Item(i).Delete
    End If
    
End Sub

' 各CommandBarから指定メニュー削除。
Public Sub DelMenu(name_to_del As String)

    For Each LoopIndex In TargetArray
        DelMenuFromSpecifiedCommandBar name_to_del, CLng(LoopIndex)
    Next
    
End Sub

' リセット。
Public Sub ResetMenu()

    For Each LoopIndex In TargetArray
        Application.CommandBars(LoopIndex).Reset
    Next
    
End Sub