自作右クリックメニューが逃げる・・・?
コンテキストメニューが逃げる
「ユーザーフォーム上のテキストボックスで右クリックメニューが使えない」問題
ユーザーフォームに設置したテキストボックス(いや、テキストボックスに限りませんけど)にテキスト入力しているときに右クリックが効かない、というのはわりかし有名なんじゃないかと思う。
普通に考えたら、これは不便な話。もちろん、ショートカットキーは生きているから、クリップボードの内容をペーストしたけりゃ[Ctrl]+[V]でおkなんだけれど、普段とことん慣れ親しんだ動作だけに、やはり右クリックメニューは出てきてほしい。
どうにかならないものなのか、とggっていて発見したのがコチラおよびコチラ。大いに参考にさせていただいた。
右クリックメニュー実現のための要点
要するに、
- 呼び出される処理を標準モジュールに準備しておく。
- フォームのインスタンス化時にCommandBarオブジェクトを追加する。
- テキストボックスの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」のメンバだし。
実行してみる
テキストボックス上で右クリックすると、
おおっ! ちゃーんと右クリックメニューが出ましたよ! 感動!
しかーし!
「貼り付け」をクリックすると(あ、ちなみに、クリップボードには既にテキストをコピー済みです)、
(゚Д゚)ハァ?
分かりますか? なんと、右クリックメニューが逃げたんです。右下に。
めげずに、追いかけてもう一度「貼り付け」をクリックすると、
無事に「貼り付け」は実行される。
これ、他の3つ(「切り取り」、「コピー」、「全て選択」)のどれをやっても同じ挙動になる。
何でなんだ???
まあ、たぶん、どうせしょうもない原因なんでしょうけれど……。