C
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
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