■Sheet1に追加
Option Explicit Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Dim myCB As CommandBar Dim myCBCtrl As CommandBarControl On Error Resume Next CommandBars("User_Short_Menu").Delete On Error GoTo 0 right_click = False Set target_cell = Target Set myCB = Application.CommandBars.Add(Name:="User_Short_Menu", Position:=msoBarPopup) Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton) myCBCtrl.Caption = "1" myCBCtrl.OnAction = "S_WriteValue" myCBCtrl.FaceId = 41 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton) myCBCtrl.Caption = "2" myCBCtrl.OnAction = "S_WriteValue" myCBCtrl.FaceId = 41 Set myCBCtrl = myCB.Controls.Add(Type:=msoControlButton) myCBCtrl.Caption = "通常メニュー" myCBCtrl.OnAction = "S_Right_Click" myCBCtrl.FaceId = 31 myCBCtrl.BeginGroup = True '区切り線の表示 '作成したメニューの表示 myCB.ShowPopup If right_click Then Cancel = False Else Cancel = True End If Application.CommandBars("User_Short_Menu").Delete Set target_cell = Nothing End Sub
■標準モジュールに追加
Option Explicit Public target_cell As Range Public right_click As Boolean Private Sub S_WriteValue() target_cell.Value = Application.CommandBars("User_Short_Menu").Controls.Item(Application.Caller(1)).Caption End Sub Private Sub S_Right_Click() right_click = True End Sub