つらつら Excel VBA

私の備忘録です。

Excel VBA 右クリックメニュー作成

■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