Excel の右クリックメニューへのメニュー追加でトラブル

先日、お客様から普段使ってるPCでトラブルがあったので予備のノートPCに変えたら、Excelで右クリックメニューに追加しているはずのメニューが表示されなくなった、と連絡がきました（マクロでメニューの追加表示処理を行っているファイルになります）。

最初は、ファイルが壊れたか？と思ってファイルを送ってもらってこちらで試しても問題なく動作します。

じゃあ、環境が変わったのだから、Excelのマクロ周りの設定かな？と思って、そちらも確認してもらっても、こんな感じに

『警告を表示してすべてのマクロを無効にする』が選ばれていました。おまけに、ファイルを開いた際に黄色の警告バーで『マクロを有効にする』を押した覚えもあるとのことでした。

という感じで、どうなってんの？と、ちょっとはまってしまったので、顛末をメモにして残しておきます。

調査

まずは、何が起きているか調査しました。ネットをあさってみると、割とすぐ、似たような現象に触れている記事を見つけることができました。

「追加したはずの右クリックメニューが表示されない」事件 - Infomentのブログ～Excel VBA奮闘記～

これによると、改ページプレビューの場合、右クリックメニューが表示されないことがある、とのことでした。でも、問題が起きてるPCで開いているのは、『標準』ビューだしなー、と思って、もうちょっと記事を追いかけてみると、

「追加したはずの右クリックメニューが表示されない事件」の真相 ① - Infomentのブログ～Excel VBA奮闘記～

とあります。

CommandBars に『Cell』の名前を持つオブジェクトが複数ある、とあります。

まさかと思って、問題が起きているPCでの挙動をよく見てみると、『標準』ビューでは右クリックメニューの追加メニューが表示されていないのですが、『改ページプレビュー』で右クリックすると、見事に追加メニューが表示されていました。

ああ、これですね。どうも、CommandBarsのオブジェクトの並びがExcelによって変わっているようです（問題が起きているノートと問題がないPCのExcelのバージョンは全く同じでしたので、バージョン以外で何が影響しているかまでは分かりませんでした）。

対応策

原因が分かってしまえば、あとは簡単です。今回の場合は、どちらのビューの場合にも右クリックメニューを表示させれば問題ないはずです。

ということで、 ThisWorkbook に

Private Function listupCommandBars() As Collection

    Dim lst As Collection
    Set lst = New Collection
    
    ' 指定の名前を持つコマンドバーをリストアップ
    Dim cmdbar As CommandBar
    For Each cmdbar In Application.CommandBars
    
        If cmdbar.Name = "Cell" Then
            lst.add cmdbar
        End If
    Next

    Set listupCommandBars = lst
End Function


' コンテキストメニューの追加
Public Sub addContextMenu()

    Dim lst As Collection
    Set lst = listupCommandBars
    
    Dim cmdbar As CommandBar
    For Each cmdbar In lst
        addContextMenuOnCmdbar cmdbar
    Next
    
End Sub
Private Sub addContextMenuOnCmdbar(ByRef cmdbar As CommandBar)

    Dim ctx_menu As CommandBarControl
    
    Set ctx_menu = cmdbar.Controls.add(Type:=msoControlButton, temporary:=True)

    With ctx_menu
        .Caption = "テスト"
        .OnAction = callbackMethodTest
        .BeginGroup = True
    End With
End Sub

' コンテキストメニューの削除
Public Sub removeContextMenu()

    Dim lst As Collection
    Set lst = listupCommandBars
    
    Dim cmdbar As CommandBar
    For Each cmdbar In lst
        removeContextMenuOnCmdbar cmdbar
    Next

End Sub
Private Sub removeContextMenuOnCmdbar(ByRef cmdbar As CommandBar)
    ' コンテキストメニュー未登録時にはエラーが発生するので回避できるようにする
    On Error Resume Next
    cmdbar.Controls( "テスト").Delete
    On Error GoTo 0
End Sub

という感じで、右クリックメニュー追加・削除用の処理を書いておいて、実際に右クリックメニューを追加したいワークシート側で

Option Explicit

' ワークシートがフォーカスを失ったら、追加したメニューを取り除く
Private Sub Worksheet_Deactivate()
    'Debug.Print "worksheet.deactivate called"
    ThisWorkbook.removeContextMenu
End Sub

' コンテキストメニューの追加
'   ワークシート上で右クリックすると、メニューが追加されて表示される
'
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean)
    ThisWorkbook.removeContextMenu
    ThisWorkbook.addContextMenu
End Sub