Excel + VBA: changing right click menu when clicking above autoshapes.

Question

I am doing a little Excel + vba application and I have got stuck. I know that using

Application.CommandBars("Cell").Controls.*

I can change right click menu to only show specific options for specific cell (of course with additional code).

But is there a way to change the menu when I click right mouse button above autoshape?

I have been using something like

(...)
'checking autoshape position
sh_le = sh.Left
sh_to = sh.Top
sh_ri = sh.Left + sh.Width
sh_do = sh.Top + sh.Height

'checking clicked cell position
cc_le = cel.Left
cc_to = cel.Top
cc_ri = cel.Left + cel.Width
cc_do = cel.Top + cel.Height

If (sh_le <= cc_le) And (sh_to <= cc_to) And (sh_ri >= cc_ri) And (sh_do >= cc_do) Then  
 'build custom menu
end if

It looks good (at least I think so :) - but when I am clicking above shape, the Worksheet_BeforeRightClick is not starting. Is there any other way to do so? I would be grateful for any information.

Answer 1

There is an undocumented featurette that means this event may not fire until you have closed the file and reopened it.

Give that a try.

Answer 2

I have implemented this way. As in code OnAction = "openOrder" where openOrder is Public Module to do the job.

You can change the CommandBars("Cell").Controls to CommandBars("Shapes").Controls

Private Sub Workbook_Deactivate()
    On Error Resume Next
    Application.CommandBars("Cell").Controls("View order").Delete
    On Error GoTo 0
End Sub

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

        Dim cBut As CommandBarButton

        On Error Resume Next

        If IneedCustomMenu=TRUE Then
            On Error Resume Next
            Set cBut = Application.CommandBars("Cell").Controls.Add(Temporary:=True)
                With cBut
                   .Caption = "View order"
                   .Style = msoButtonCaption
                   .OnAction = "openOrder"
                End With
            On Error GoTo 0
        Else
               On Error Resume Next
               With Application
                        .CommandBars(Cell).Controls("View order").Delete
               End With
        End If
       End Sub