ExeclVBAユーザーフォームから右クリックでショートカットメニューで困っています。

ExcelVBAのユーザーフォーム上で、テキストなどを編集する際に右クリックしてコピー＆ペーストとかのショートカットメニューを出したいんでけど、出せないものなのでしょうか？書籍などにはワークシート上で自作の右クリックのショートカットマクロを割り付ける、というTipsが掲載されていますが、参考にコードを書いてもうまくいきません。

No.4 回答者： chibita_papa 回答日時： 2007/04/27 13:24

NO1です。

ユーザーフォーム上ですね。
失礼しました。
サンプルは、ワークシート上です。
無視してください。

No.3 回答者： KenKen_SP 回答日時： 2007/04/27 13:06

こんにちは。

Userform1 に Textbox1 を配置し、以下のコードをそれぞれコメントにある
モジュールにコピペして下さい。

右クリックは「MouseUp」イベントで検知できます。

とりあえず、コピー＆ペーストを簡単...と言うかかなり手抜きですが、
実装してみました。例外処理は最小限しかしてません。

' // Userform1 ------------------------------------------------------

Private Const MENUNAME As String = "RIGHT_CLICK_MENU"
Private mCB As CommandBar

Private Sub UserForm_Initialize()
　　Call CreatePopupMenu
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
　　Call DeletePopupMenu
End Sub

' // 右クリックメニュー作成
Private Sub CreatePopupMenu()
　　
　　Call DeletePopupMenu
　　Set mCB = Application.CommandBars _
　　　　　　 .Add(Name:=MENUNAME, _
　　　　　　　　　Position:=msoBarPopup, _
　　　　　　　　　MenuBar:=False, _
　　　　　　　　　Temporary:=True)
　　With mCB.Controls.Add(Type:=msoControlButton)
　　　　.Caption = "コピー(&C)"
　　　　.OnAction = "CopyText"
　　　　.FaceId = 19
　　End With
　　With mCB.Controls.Add(Type:=msoControlButton)
　　　　.Caption = "貼り付け(&V)"
　　　　.OnAction = "PasteText"
　　　　.FaceId = 22
　　End With

End Sub

' // 右クリックメニュー削除
Private Sub DeletePopupMenu()
　　On Error Resume Next
　　Application.CommandBars(MENUNAME).Delete
　　Set mCB = Nothing
　　On Error GoTo 0
End Sub

'// Textbox1 の右クリックで PopupMenu を呼び出し
Private Sub TextBox1_MouseUp(ByVal Button As Integer, _
　　　　　　　　　　　　　　 ByVal Shift As Integer, _
　　　　　　　　　　　　　　 ByVal X As Single, _
　　　　　　　　　　　　　　 ByVal Y As Single)
　　If Button = xlSecondaryButton Then
　　　　mCB.ShowPopup
　　End If
End Sub


' // 標準モジュール -------------------------------------------------

' // かなり手抜きです。この方法は必ずうまくいくとは限りません。
' // コピーコマンド
Sub CopyText()
　　On Error Resume Next
　　AppActivate (UserForm1.Caption)
　　If Err.Number = 0 Then SendKeys "^c", True
End Sub

'// ペーストコマンド
Sub PasteText()
　　On Error Resume Next
　　AppActivate (UserForm1.Caption)
　　If Err.Number = 0 Then SendKeys "^v", True
End Sub

この回答へのお礼

スゲエ。こんなのがやりたかったんです。大変ありがとう御座いました。

お礼日時：2007/04/27 13:53

No.2 回答者： Wendy02 回答日時： 2007/04/27 12:19

こんにちは。

Excel　VBAのUserFormのテキストボックスなどには、右クリックイベント自体はありますが、UserForm上の右クリックメニューは用意できないと思います。

No.1 回答者： chibita_papa 回答日時： 2007/04/26 16:18

ワークブックをオープンした時に右クリックのメニューをセット

閉じる時にメニューをクリアするサンプルです。

ThisWorkbookに貼り付けて使います。

Private Sub Workbook_Open()

Dim Newb As Variant

Set Newb = Application.CommandBars("Cell").Controls.Add(Temporary:=True, before:=1)
With Newb
.Caption = "転送ファイル作成"
.OnAction = "転送ファイル作成"
.BeginGroup = True
.FaceId = 283
End With

Set Newb = Application.CommandBars("Cell").Controls.Add(Temporary:=True, before:=1)
With Newb
.Caption = "月次更新"
.OnAction = "GetujiKosin"
.BeginGroup = True
.FaceId = 1015
End With

Set Newb = Application.CommandBars("Cell").Controls.Add(Temporary:=True, before:=1)
With Newb
.Caption = "個別明細書印刷"
.OnAction = "KOPRINT"
.BeginGroup = False
.FaceId = 4
End With

Set Newb = Application.CommandBars("Cell").Controls.Add(Temporary:=True, before:=1)
With Newb
.Caption = "総括明細書印刷"
.OnAction = "PPRINT"
.BeginGroup = True
.FaceId = 4
End With

Set Newb = Application.CommandBars("Cell").Controls.Add(Temporary:=True, before:=1)
With Newb
.Caption = "受信データー変換"
.OnAction = "Import"
.BeginGroup = True
.FaceId = 4
End With
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)

On Error Resume Next

Err.Clear
Do
Application.CommandBars("cell").Controls("総括明細書印刷").Delete
Loop While Err.Number = 0

Err.Clear
Do
Application.CommandBars("cell").Controls("個別明細書印刷").Delete
Loop While Err.Number = 0

Err.Clear
Do
Application.CommandBars("cell").Controls("月次更新").Delete
Loop While Err.Number = 0

Err.Clear
Do
Application.CommandBars("cell").Controls("転送ファイル作成").Delete
Loop While Err.Number = 0

Err.Clear
Do
Application.CommandBars("cell").Controls("受信データー変換").Delete
Loop While Err.Number = 0

End Sub

この回答への補足

回答ありがとう御座います。早速試してみました。Excelワークシート上で右クリックをするとショートカットメニューが出るのですが、
作成したユーザーフォーム上では出ませんでした。
Application.CommandBarsの引数が"Cell"になっているのは、ワークシート上だからと思い、引数を"UserForm"などに変えてみてもエラーなってしまい、うまくいきません。なにか有効なパラメータとか、そうでないものがあるのでしょうか？

補足日時：2007/04/27 08:00