Context Menu Events?

[Remsai]

Hello,

Is it possible to capture a context(right click) menu event?

Like to show a msgbox when you click delete on the cell context menu.

I've searched everywhere online, but I can't seem to find anything.

I know that I can make a custom context menu, however that is not what I want.

I found "CommandBars.OnUpdate Event (Office)" and how to capture command bar events.

Thanks

 

[Remsai]

Bump

 

[Jaafar Tribak]

The following worked for me for displaying a messagebox before clicking the Delete button on the cell right-click context menu.. The messagebox asks the user if they want to go ahead with the deletion or not.

1- In a Standard Module :

Option Explicit

Private Type POINTAPI
    x As Long
    Y As Long
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  Win64 Then
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal arg1 As LongPtr, ppacc As IAccessible, pvarChild As Variant) As Long
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Declare Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetFocus Lib "user32" () As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Private Const CHILDID_SELF = &H0&
Private Const S_OK As Long = &H0


Public Sub StartWatching()
    SetTimer Application.hwnd, 0, 0, AddressOf Pseudo_Before_RightClick_Event
End Sub

Public Sub StopWatching()
    KillTimer Application.hwnd, 0
End Sub

Private Sub Pseudo_Before_RightClick_Event()
    Dim tPt As POINTAPI
    Dim oIA As IAccessible
    Dim sBuf As String * 256
    Dim lRes As Long
 
    GetCursorPos tPt
    
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  Win64 Then
        Dim lngPtr As LongPtr
        CopyMemory lngPtr, tPt, LenB(tPt)
        lRes = AccessibleObjectFromPoint(lngPtr, oIA, 0)
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        lRes = AccessibleObjectFromPoint(tPt.x, tPt.Y, oIA, 0)
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    
    If lRes = S_OK Then
        lRes = GetClassName(GetFocus, sBuf, 256)
        If Left(sBuf, lRes) = "NetUIHWND" Then
            If Replace(Application.CommandBars.FindControl(ID:=292).Caption, "&", "") = oIA.accName(CHILDID_SELF) Then
                If GetAsyncKeyState(VBA.vbKeyLButton) < 0 Then
                    If MsgBox("Do you want to go ahead with deletion?", vbYesNo + vbQuestion, " Deleting ...") = vbYes Then
                        Application.Dialogs(xlDialogEditDelete).Show
                    End If
                End If
            End If
        End If
    End If
End Sub

2- In the ThisWorkbook Module :

Option Explicit

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Call StartWatching
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call StopWatching
End Sub

Private Sub Workbook_Deactivate()
    Call StopWatching
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopWatching
End Sub

 

[Remsai]

Thanks a lot Jaafar!

It worked like I wanted.

Just a quick question:

I'm thinking about the 'Start Watching' and 'Stop Watching', what happens if it doesn't stop? (Like for example if there was an error.)

Is it something like when you make a custom context menu and it changes it for all workbooks?

 

[Jaafar Tribak]

Thanks a lot Jaafar!

It worked like I wanted.

Just a quick question:

I'm thinking about the 'Start Watching' and 'Stop Watching', what happens if it doesn't stop? (Like for example if there was an error.)

Is it something like when you make a custom context menu and it changes it for all workbooks?

The StopWatching routine is called frequently to ensure thath the Timer stops after closing the custom context menu.

Even if an error occurred, the application wouldn't crash because the SetTimer API is passed the Application hwnd .

If you want to restrict the custom context menu to a specific worksheet , you can easily adapt the code.

 

[Remsai]

Thanks

 

[Remsai]

I found this on www.dailydoseofexcel.com/archives/2006/08/21/capture-deleted-rows/.

I changed it a bit to work for me.

ThisWorkbook:

Private Sub Workbook_Open()
    
    Set gclsCbarEvents = New CCbarEvents
    
End Sub

Global Variable:

Public gclsCbarEvents As CCbarEvents

Class Module: CCbarEvents

Private WithEvents mColDelButton As CommandBarButton

Private Sub Class_Initialize()
 
    Set mColDelButton = Application.CommandBars.FindControl(, 294)
    
End Sub

Private Sub mColDelButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)[INDENT]
'CancelDefault=True, To cancel delete'[/INDENT]
[INDENT]'Your Macro Here'[/INDENT]
        
End Sub

It looks much simpler and I can understand how it works.

So how is this different from Jaafar's code?
Are there any drawbacks?

Thanks

 

[Jaafar Tribak]

I found this on www.dailydoseofexcel.com/archives/2006/08/21/capture-deleted-rows/.

I changed it a bit to work for me.

ThisWorkbook:

Private Sub Workbook_Open()
    
    Set gclsCbarEvents = New CCbarEvents
    
End Sub

Global Variable:

Public gclsCbarEvents As CCbarEvents

Class Module: CCbarEvents

Private WithEvents mColDelButton As CommandBarButton

Private Sub Class_Initialize()
 
    Set mColDelButton = Application.CommandBars.FindControl(, 294)
    
End Sub

Private Sub mColDelButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)[INDENT]
'CancelDefault=True, To cancel delete'[/INDENT]
[INDENT]'Your Macro Here'[/INDENT]
        
End Sub

It looks much simpler and I can understand how it works.

So how is this different from Jaafar's code?
Are there any drawbacks?

Thanks

The difference is that the method you posted used to work on excel 2003 and prior editions but doesn't work on excel 2007 or later editions ... The standard solution normally used for excel 2007 and later is to use Ribbon XML. The remaining alternative is to use some ugly vba code workarounds like the one I posted.

 

[mikerickson]

Another approach would be to change the .OnAction property of that CommandBar.Control and send it to your own routine.
At work now and don't have time to post an example.

 

[Jaafar Tribak]

Another approach would be to change the .OnAction property of that CommandBar.Control and send it to your own routine.
At work now and don't have time to post an example.

Hi Mike.

I don't think that would work in excel 2007 or later editions... I would be surprise if it does.