自作右クリックメニューが逃げる・・・?

コンテキストメニューが逃げる

「ユーザーフォーム上のテキストボックスで右クリックメニューが使えない」問題

ユーザーフォームに設置したテキストボックス(いや、テキストボックスに限りませんけど)にテキスト入力しているときに右クリックが効かない、というのはわりかし有名なんじゃないかと思う。

普通に考えたら、これは不便な話。もちろん、ショートカットキーは生きているから、クリップボードの内容をペーストしたけりゃ[Ctrl]+[V]でおkなんだけれど、普段とことん慣れ親しんだ動作だけに、やはり右クリックメニューは出てきてほしい。

どうにかならないものなのか、とggっていて発見したのがコチラおよびコチラ。大いに参考にさせていただいた。

右クリックメニュー実現のための要点

要するに、

  1. 呼び出される処理を標準モジュールに準備しておく。
  2. フォームのインスタンス化時にCommandBarオブジェクトを追加する。
  3. テキストボックスのMouseDownイベントでCommandBarオブジェクトのShowPopupメソッドを実行してCommandBarオブジェクト(右クリックメニュー)を表示する。

ということらしい。

やってみた

まずは、標準モジュールに次のコードを書いて、テキスト編集用の処理を準備する。

リスト1 標準モジュール
Public Sub cutText()
  Application.SendKeys "^X"
End Sub
Public Sub copyText()
  Application.SendKeys "^C"
End Sub
Public Sub pasteText()
  Application.SendKeys "^V"
End Sub
Public Sub selectAll()
  Application.SendKeys "^A"
End Sub

何のことはない。Application.SendKeysメソッドを用いて、おなじみのショートカットキー押下を再現しているだけ。

んで、お次はフォームモジュール。

スト2 フォームモジュール
'宣言セクション'
Option Explicit
Private contextMenu As CommandBar    '……(1)'
Private Sub UserForm_Initialize()
  Set contextMenu = _
        Application.CommandBars.Add(Position:=msoBarPopup, _
                                    Temporary:=True)    '……(2)'
  With contextMenu
    With .Controls.Add    '……(3)'
      .Caption = "切り取り"
      .OnAction = "cutText"
      .FaceId = 21
    End With
    With .Controls.Add
      .Caption = "コピー"
      .OnAction = "copyText"
      .FaceId = 19
    End With
    With .Controls.Add
      .Caption = "貼り付け"
      .OnAction = "pasteText"
      .FaceId = 22
    End With
    With .Controls.Add
      .BeginGroup = True    '……(4)'
      .Caption = "全て選択"
      .OnAction = "selectAll"
    End With
  End With
End Sub

(1)の

Private contextMenu As CommandBar

では、フォームモジュールの宣言セクションでCommandBar型のオブジェクト変数contextMenuを宣言している。フォームモジュール内の複数のプロシージャ(「UserForm_Initialize」と、後述の「TextBoxMain_MouseDown」)から参照される変数なので、モジュールレベル変数とした。

(2)の

Set contextMenu = _
      Application.CommandBars.Add(Position:=msoBarPopup, _
                                  Temporary:=True)

では、Application.CommandBarsコレクションのAddメソッドを用いて、CommandBarオブジェクトを新しく生成して変数contextMenuにぶち込んでいる。引数Positionは、コチラによると、

新しいコマンド バーの位置または種類を指定します。使用できる定数は、 MsoBarPosition 定数のいずれかです。

ということで、msoBarPopupを指定しているので、たぶん「その場でポップアップする」ぐらいの意味なんだろう(適当)。

あと、もう一つ指定した引数Temporaryってのは、コチラ

使用が終わったとき自動的に破棄されるよう引数TemporaryにTrueを指定しておきましょう。

とあるので、そういう意味なんだろう(適当)。

(3)からの5行

With .Controls.Add    '……(3)'
  .Caption = "切り取り"
  .OnAction = "cutText"
  .FaceId = 21
End With

では、contextMenuオブジェクトの配下にControlオブジェクトを追加する処理。

ControlsコレクションのAddメソッドの引数Captionには表示される文字列、OnActionに実行されるプロシージャ名、FaceIdで表示されるアイコンを指定しているっぽい(適当)。

「切り取り」、「コピー」、「貼り付け」は同じように記述している。

「全て選択」だけはちょっと違っていて、(4)の

.BeginGroup = True

でBeginGroupプロパティをTrueにしている。

このControlオブジェクトは新しいグループに設定せよ、ということなんだろう(適当)。

あとは、テキストボックスのMouseDownイベントの設定。

リスト3 フォームモジュール
Private Sub TextBoxMain_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                                  ByVal X As Single, ByVal Y As Single)
  If Button = xlSecondaryButton Then contextMenu.ShowPopup    '……(1)'
End Sub

なんと、たったのこれだけw

(1)の

If Button = xlSecondaryButton Then contextMenu.ShowPopup

イベント発生時に受け取った引数Buttonの中身が「2」だったら、右クリックされたということになるので、CommandBarオブジェクトのShowPopupメソッドを実行する、ということだ。

「2」と指定する代わりにxlSecondaryButtonを指定しているが、たぶんこれでいいと思う(適当)。「XlMouseButton」のメンバだし。

実行してみる

テキストボックス上で右クリックすると、

f:id:akashi_keirin:20180101004728j:plain

おおっ! ちゃーんと右クリックメニューが出ましたよ! 感動!

しかーし!

「貼り付け」をクリックすると(あ、ちなみに、クリップボードには既にテキストをコピー済みです)、

f:id:akashi_keirin:20180101004735j:plain

(゚Д゚)ハァ?

分かりますか? なんと、右クリックメニューが逃げたんです。右下に。

めげずに、追いかけてもう一度「貼り付け」をクリックすると、

f:id:akashi_keirin:20180101004743j:plain

f:id:akashi_keirin:20180101004751j:plain

無事に「貼り付け」は実行される。

これ、他の3つ(「切り取り」、「コピー」、「全て選択」)のどれをやっても同じ挙動になる。

何でなんだ???

まあ、たぶん、どうせしょうもない原因なんでしょうけれど……。