Take out the Workbook_Activate event. And use the code below to which I've made some modifications
Code:Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) If Target.Columns.Count = Columns.Count Then Call AddToCellMenu("Row") ElseIf Target.Rows.Count = Rows.Count Then Call AddToCellMenu("Column") Else Call AddToCellMenu("Cell") End If End Sub Private Sub Workbook_Deactivate() Call DeleteFromCellMenu End Sub Sub AddToCellMenu(strCommandBarName As String) Dim ContextMenu As CommandBar Dim MySubMenu As CommandBarControl ' Delete the controls first to avoid duplicates. Call DeleteFromCellMenu ' Set ContextMenu to the Cell context menu. Set ContextMenu = Application.CommandBars(strCommandBarName) ' Add one built-in button(Save = 3) to the Cell context menu. ContextMenu.Controls.Add Type:=msoControlButton, ID:=3, before:=1 ' Add one custom button to the Cell context menu. With ContextMenu.Controls.Add(Type:=msoControlButton, before:=2) .OnAction = "'" & ThisWorkbook.Name & "'!" & "ToggleCaseMacro" .FaceId = 59 .Caption = "Toggle Case Upper/Lower/Proper" .Tag = "My_Cell_Control_Tag" End With ' Add a custom submenu with three buttons. Set MySubMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, before:=3) With MySubMenu .Caption = "Case Menu" .Tag = "My_Cell_Control_Tag" With .Controls.Add(Type:=msoControlButton) .OnAction = "'" & ThisWorkbook.Name & "'!" & "UpperMacro" .FaceId = 100 .Caption = "Upper Case" End With With .Controls.Add(Type:=msoControlButton) .OnAction = "'" & ThisWorkbook.Name & "'!" & "LowerMacro" .FaceId = 91 .Caption = "Lower Case" End With With .Controls.Add(Type:=msoControlButton) .OnAction = "'" & ThisWorkbook.Name & "'!" & "ProperMacro" .FaceId = 95 .Caption = "Proper Case" End With End With ' Add a separator to the Cell context menu. ContextMenu.Controls(4).BeginGroup = True End Sub Sub DeleteFromCellMenu() Dim ContextMenu As CommandBar Dim ctrl As CommandBarControl Dim lng As Long Const strBarNames As String = "Cell,Column,Row" ' Set ContextMenu to the Cell context menu. For lng = LBound(Split(strBarNames, ",")) To UBound(Split(strBarNames, ",")) Set ContextMenu = Application.CommandBars(Split(strBarNames, ",")(lng)) ' Delete the custom controls with the Tag : My_Cell_Control_Tag. For Each ctrl In ContextMenu.Controls If ctrl.Tag = "My_Cell_Control_Tag" Then ctrl.Delete End If Next ctrl Next lng ' Delete the custom built-in Save button. While Not ContextMenu.FindControl(ID:=3) Is Nothing ContextMenu.FindControl(ID:=3).Delete Wend End Sub




Reply With Quote
Bookmarks