Excel 2007, Custom Right Click Menu Doesn't Work in Table, Help!

[cpmame]

I am trying to customize a right click menu at particular cell location.
However I realize that this method only apply to the cell region, and does
not work on the Table region. For example, I have created a 2x5 table called
"Table1" in sheet1. The following code is suppose to give me a different
right click menu when my right click is within Table region, and back to
default when it is outside the region. However, it doesn't work the way I
wanted. What is the problem? Please help


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As
Boolean)
If Not Intersect(Target, Sheets(1).Range("Table1")) Is Nothing Then
'Uncomment the following will work if right click outside the table region
'If Intersect(Target, Sheets(1).Range("Table1")) Is Nothing Then
On Error Resume Next
With Application
Dim cControl As CommandBarControl
For Each cControl In .CommandBars("Cell").Controls
cControl.Delete
Next cControl
Dim cBut As CommandBarButton
Dim ii As Integer
For ii = 1 To 3
Set cBut = .CommandBars("Cell").Controls.Add(Temporary:=True)
cBut.Caption = ii
cBut.Style = msoButtonCaption
cBut.OnAction = "MySubStampText"
Next ii
End With
On Error GoTo 0
Else
Application.CommandBars("Cell").Reset
End If
End Sub

Private Sub MySubStampText()
ActiveCell = Application.CommandBars.ActionControl.Caption
End Sub

 

[Ron de Bruin]

Hi cpmame

This is the name of this Popup

Application.CommandBars("List Range Popup")

 

[cpmame]

Hi Ron,
Thanks, you have solved my problem.

Hi cpmame

This is the name of this Popup

Application.CommandBars("List Range Popup")

 

[Shivi]

Try this code to list out all command bars in your excel setup

Sub commdbrs()
i = 0
For Each cb In CommandBars
i = i + 1
Worksheets("sheet1").Range("A" & i).Value = cb.Name
Next cb
End Sub

 

[merlin777]

I have a similar problem. I changed "cell" to "list range popup" but nothing changed. It still works outside the table but not inside.

This is the code I'm using:

Private Sub Workbook_Open() On Error Resume Next
Dim NewControl As CommandBarControl
Application.CommandBars("cell").Controls("Insert Date").Delete
Set NewControl = Application.CommandBars("cell").Controls.Add
With NewControl
.Caption = "Insert Date"
.OnAction = "Module1.OpenCalendar"
.BeginGroup = True
End With
End Sub