ワードの右クリックメニューへのマクロ登録

「公用文テンプレート」に右クリックメニュー（コンテキストメニュー）を追加しようとして、ハマってしまいましたので、そのてんまつを記録しておきたいと思います。結論としては、不具合が解消できず、使用を中止しました。

ワードで右クリックメニューにコマンドを追加できるのか？

エクセルでは、右クリックメニューを設定したことがあるのですが、ワードではやったことがなかったので、そもそもできるかどうかが問題でした。

結論としては、私の環境では、エクセルとほぼ同じ方法で問題なく実現できています。
ただし、ネット上では、リボンメニューに変わってからはXMLを編集してリボンをカスタマイズしないとできないという情報もありますので、環境によっては問題が生じるかも知れません。（実際、生じました。）

コマンドバーの名前は何だ？

エクセルの場合は、次のコードで右クリックメニューにコマンドを追加することができます。

CommandBars("cell").Controls.Add(Type:=msoControlButton)

問題は、「cell」というコマンドバーの名前の部分です。
このままワードで使っても、エラーが生じてしまいました。
ワードにセルはありませんから、当たり前ですよね。

ネットを検索したところ、VBAでコマンドバーの名前の一覧を取得する方法が紹介されていました。

リボンの各種コマンドの一覧を取得する ｜ Excel作業をVBAで効率化

コマンドとは VBAではCommandBarsというプロパティがあります。 これは簡単に言うとリボンにある各機能を参照するプロパティです。 ホームタブであれば、貼り付け、フォント、背景色、などの機能がありますがこれらがそ …

vbabeginner.net

これをワードで実行するとたくさんのコマンドが表示されます。
そのうち「公用文テンプレート」で必要なのは、「text」、「Lists」および「Headings」の3つのようです。
最初は「text」だけだと思ったのですが、実行してみると箇条書きや段落番号および見出しの右クリックメニューには、本文とは別の名前が付けられていることが分かりました。

あとはエクセルと同じ方法で右クリックメニューを追加することができます。

どうやって実行する？

ところが、問題はそれだけではありませんでした。
右クリックメニューを追加するマクロにイベントプロシージャが使用できないのです。
（「公用文テンプレート」は、アドインなどとして使用することを想定しているからです。）
このため、「AutoExec」などの自動実行プロシージャを使用する必要があります。

また、右クリックメニューは、クイックアクセスツールバーのようにメニュー操作では削除できません（もちろん追加もできません）。
このため、「公文書テンプレート」を終了した際には、追加したコマンドを削除しなければなりません。

いろいろと試したところ「AutoExec」で追加を行い、「AutoExit」で削除を行う必要がありました。「AutoNew」、「AutoOpen」「AutoClose」などもありますが、アドインとして使う場合には「AutoExec」と「AutoExit」の組み合わせが適しているようです。（後に、ある環境下でメニューが残ってしまう事象が発生したので、「AutoClose」も追加しました。）

マクロを複数回起動させるとメニューが重複して設定されてしまうという問題は、起動するたびに既に追加されているメニューを削除することで回避することができました。

Macでは使えない。

この右クリックメニューのマクロは、Macではエラーになることが分かりました。
（考えてみれば当たり前です。）
エラーが生じた場合には、処理を中止するようにして問題を回避するようにしました。

できあがったコード

以上のような試行錯誤を繰り返してできあがったのが次のコードです。

Sub AutoExec()
'〇アドインとして起動した場合に処理を行う
    '右クリックメニューからコマンドを削除する
    '右クリックメニューが残る場合があるため、一旦削除しています。
    Call DelContext
    '右クリックメニューにコマンドを追加する
    Call AddContext
End Sub

Sub AutoExit()
'〇アドインを終了した場合に処理を行う
    '右クリックメニューからコマンドを削除する
    Call DelContext
End Sub

Sub AutoClose()
'文書を閉じた場合に処理を行う
    '右クリックメニューからコマンドを削除する
    Call DelContext
End Sub

Sub AddContext()
'〇エラー処理を行う
'Macではエラーが生じるようです。
On Error GoTo HandleErr

'・本文の右クリックメニューにコマンドを追加する
With CommandBars("text").Controls.Add(Type:=msoControlButton)
    .Caption = "太字（VA公用文）"
    .OnAction = "ChangeSelectionToBold"
    .FaceId = 253
    .BeginGroup = True
    .Tag = "VA公用文"
End With
With CommandBars("text").Controls.Add(Type:=msoControlButton)
    .Caption = "標準（VA公用文）"
    .OnAction = "ChangeSelectionToStandard"
    .FaceId = 253
    .BeginGroup = False
    .Tag = "VA公用文"
End With
With CommandBars("text").Controls.Add(Type:=msoControlButton)
    .Caption = "インデント設定（VA公用文）"
    .OnAction = "AlineSelectionIndent"
    .FaceId = 121
    .BeginGroup = True
    .Tag = "VA公用文"
End With
With CommandBars("text").Controls.Add(Type:=msoControlButton)
    .Caption = "インデント解除（VA公用文）"
    .OnAction = "UndoSelectionIndent"
    .FaceId = 120
    .BeginGroup = False
    .Tag = "VA公用文"
End With

'リストの右クリックメニューにコマンドを追加する
With CommandBars("Lists").Controls.Add(Type:=msoControlButton)
    .Caption = "太字（VA公用文）"
    .OnAction = "ChangeSelectionToBold"
    .FaceId = 253
    .BeginGroup = True
    .Tag = "VA公用文"
End With
With CommandBars("Lists").Controls.Add(Type:=msoControlButton)
    .Caption = "標準（VA公用文）"
    .OnAction = "ChangeSelectionToStandard"
    .FaceId = 253
    .BeginGroup = False
    .Tag = "VA公用文"
End With
With CommandBars("Lists").Controls.Add(Type:=msoControlButton)
    .Caption = "インデント設定（VA公用文）"
    .OnAction = "AlineSelectionIndent"
    .FaceId = 121
    .BeginGroup = True
    .Tag = "VA公用文"
End With
With CommandBars("Lists").Controls.Add(Type:=msoControlButton)
    .Caption = "インデント解除（VA公用文）"
    .OnAction = "UndoSelectionIndent"
    .FaceId = 120
    .BeginGroup = False
    .Tag = "VA公用文"
End With

'見出しの右クリックメニューにコマンドを追加する
With CommandBars("Headings").Controls.Add(Type:=msoControlButton)
    .Caption = "太字（VA公用文）"
    .OnAction = "ChangeSelectionToBold"
    .FaceId = 253
    .BeginGroup = True
    .Tag = "VA公用文"
End With
With CommandBars("Headings").Controls.Add(Type:=msoControlButton)
    .Caption = "標準（VA公用文）"
    .OnAction = "ChangeSelectionToStandard"
    .FaceId = 253
    .BeginGroup = False
    .Tag = "VA公用文"
End With
With CommandBars("Headings").Controls.Add(Type:=msoControlButton)
    .Caption = "インデント設定（VA公用文）"
    .OnAction = "AlineSelectionIndent"
    .FaceId = 121
    .BeginGroup = True
    .Tag = "VA公用文"
End With
With CommandBars("Headings").Controls.Add(Type:=msoControlButton)
    .Caption = "インデント解除（VA公用文）"
    .FaceId = 120
    .OnAction = "UndoSelectionIndent"
    .BeginGroup = False
    .Tag = "VA公用文"
End With

Exit Sub
HandleErr:
End Sub

Sub DelContext()
'〇コマンドを削除する
'「Va公用文」のタグが付けられたコマンドを全て削除します。
'これを先に行わないと、既にコマンドが追加されている場合に2重に設定されてしまいます。
Dim objCommand As Object

'エラー処理を行う
'Macではエラーが生じるようです。
On Error GoTo HandleErr

'本文の右クリックメニューからコマンドを削除する
For Each objCommand In CommandBars("text").Controls
    If objCommand.Tag = "VA公用文" Then objCommand.Delete
Next

'リストの右クリックメニューからコマンドを削除する
For Each objCommand In CommandBars("Lists").Controls
    If objCommand.Tag = "VA公用文" Then objCommand.Delete
Next

'見出しの右クリックメニューからコマンドを削除する
For Each objCommand In CommandBars("Headings").Controls
    If objCommand.Tag = "VA公用文" Then objCommand.Delete
Next
Exit Sub
HandleErr:
End Sub

表で右クリックメニューを使うためには

表で右クリックメニューを使う場合には、次の3つのコマンドバーに設定を行う必要があります。

• Table Text
• Table Cells
• Whole Table

コマンドバーの一覧の取得および初期状態へのリセットは、次のコードで行うことができます。

Sub ShowCommand()
'コマンドバーの名前の一覧を取得する
Dim i As Long
For i = 1 To CommandBars.Count
    Debug.Print CommandBars(i).Name
Next
End Sub

Sub ResetCommand()
'すべてのコマンドを初期状態にリセットする
Dim i As Long
For i = 1 To CommandBars.Count
    Application.CommandBars(i).Reset
Next
End Sub

なぜか正常に作動しなくなり．．使用を断念！

上記のコードで1年以上問題なく使用してきたのですが、最近（2024年6月）になって急に調子が悪くなりました。
メニューが一部登録されなくなったり、二重に登録されたり、空白のメニューが登録されたりします。文字列を選択していない状態で問題がなくても、選択すると不具合が生じます。
やっかいなことに、事務所のPCでは問題がないのに、自宅のPCでは発生します。
リセットや削除のコードをいろいろいじったり、ワードを再インストールしたり、Normal.dotmを削除したり、Word関連のレジストリを削除したり、思いつくことはすべてやりましたが不具合が解消しませんでした。
このため、VBAアセットのサンプルファイルでは、右クリックメニューを設定しないように変更しました。
残念！