Custom Context Menu not working for one User?

J

jmpatrick

Active Member
Joined
Aug 17, 2016
Messages
482
Office Version
  1. 365
Platform
  1. Windows
Good morning.

I have this fabulous code that loads a Custom Context Menu at Workbook open. It opens correctly for all Users except for one. Very strange! This User can run Macros no problem and all her security settings match, but no right-click menu. Here's my code:

VBA Code: 
Sub AddToCellMenu()

    Dim ContextMenu As CommandBar
    Dim MySubMenu As CommandBarControl

    'Delete the controls first to Avoid duplicates
    Call DeleteFromCellMenu

    'Set ContextMenu to the Cell menu
    Set ContextMenu = Application.CommandBars("Cell")
   
    'Add one built-in button(Save = 3)to the cell menu
    ContextMenu.Controls.Add Type:=msoControlButton, ID:=1, Before:=1

    'Add one custom button to the Cell menu
    With ContextMenu.Controls.Add(Type:=msoControlButton, Before:=1)
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "OpenSearchEditFill"
        .Caption = "Open/Edit Job"
    End With
   
    ContextMenu.Controls(2).BeginGroup = True
   
    'Add one built-in button(Save = 3)to the cell menu
    ContextMenu.Controls.Add Type:=msoControlButton, ID:=2, Before:=2

    'Add one custom button to the Cell menu
    With ContextMenu.Controls.Add(Type:=msoControlButton, Before:=2)
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "CopyShippingInstructions"
        .Caption = "Copy Shipping Instructions"
    End With
      
    ContextMenu.Controls(3).BeginGroup = True
   
    'Add custom menu with three buttons
    Set MySubMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, Before:=3)

    With MySubMenu
        .Caption = "Options"
        .Tag = "My_Cell_Control_Tag"
      
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "OptionComment"
            .FaceId = 31
            .Caption = "Add Options"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "DeleteOptionsComment"
            .FaceId = 31
            .Caption = "Delete Options"
        End With

    End With

    ContextMenu.Controls(4).BeginGroup = True
   
    Set MySubMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, Before:=4)
   
    With MySubMenu
        .Caption = "Cell Comments"
        .Tag = "My_Cell_Control_Tag"

        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "GeneralComment"
            .FaceId = 31
            .Caption = "Add Comment"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "DeleteGeneralComment"
            .FaceId = 31
            .Caption = "Delete Comment"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "OpenFloorComment"
            .FaceId = 31
            .Caption = "Add Floor Schedule A Total"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "DeleteFloorComment"
            .FaceId = 31
            .Caption = "Delete Floor Schedule A Total"
        End With
              
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "DeleteComment"
            .FaceId = 31
            .Caption = "Delete Sent To CC"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "AddFMComment"
            .FaceId = 31
            .Caption = "Sent To Field Manager"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "DeleteFMComment"
            .FaceId = 31
            .Caption = "Delete Sent To Field Manager"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "OpenWebComment"
            .FaceId = 31
            .Caption = "Add Open Web PO Number"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "DeleteOpenWebComment"
            .FaceId = 31
            .Caption = "Delete Open Web PO Number"
        End With

    End With

    ContextMenu.Controls(5).BeginGroup = True
   
    Set MySubMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, Before:=5)

    With MySubMenu
        .Caption = "Links"
        .Tag = "My_Cell_Control_Tag"

        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "AddLink"
            .FaceId = 6853
            .Caption = "Add Asset Link"
        End With
              
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "AddLinkGroupShort"
            .FaceId = 6853
            .Caption = "Add All Asset Links"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "DeleteLink"
            .FaceId = 6853
            .Caption = "Delete Asset Link"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "DeleteLinkGroupAll"
            .FaceId = 6853
            .Caption = "Delete All Asset Links"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "AddFloorlink"
            .FaceId = 6857
            .Caption = "Add Floor Link"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "DeleteFloorLink"
            .FaceId = 6857
            .Caption = "Delete Floor Link"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "AddBOM"
            .FaceId = 6855
            .Caption = "Add BOM Link"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "DeleteBOM"
            .FaceId = 6855
            .Caption = "Delete BOM Link"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "AddRT"
            .FaceId = 6854
            .Caption = "Add Roof Truss Link"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "DeleteRT"
            .FaceId = 6854
            .Caption = "Delete Roof Truss Link"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "FixLinks"
            .FaceId = 1074
            .Caption = "Fix Links"
        End With
       
    End With

    'Add seperator to the Cell menu
    ContextMenu.Controls(6).BeginGroup = True
   
    Set MySubMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, Before:=6)

    With MySubMenu
        .Caption = "Mark Confirmed/Unconfirmed"
        .Tag = "My_Cell_Control_Tag"

        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "MarkConfirmed"
            .FaceId = 1087
            .Caption = "Mark Confirmed"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "MarkUnconfirmed"
            .FaceId = 1088
            .Caption = "Mark Unconfirmed"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "MarkConfirmedBOM"
            .FaceId = 1087
            .Caption = "Mark Confirmed BOM"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "MarkUnconfirmedBOM"
            .FaceId = 1088
            .Caption = "Mark Unconfirmed BOM"
        End With
       
    End With
   
    'Add seperator to the Cell menu
    ContextMenu.Controls(7).BeginGroup = True
   
    Set MySubMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, Before:=7)

    With MySubMenu
        .Caption = "Mark As Model"
        .Tag = "My_Cell_Control_Tag"

        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "MarkModel"
            .FaceId = 1087
            .Caption = "Mark As Model"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "UnMarkModel"
            .FaceId = 1088
            .Caption = "Unmark As Model"
        End With
       
    End With
   
    'Add seperator to the Cell menu
    ContextMenu.Controls(8).BeginGroup = True
   
    Set MySubMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, Before:=8)

    With MySubMenu
        .Caption = "Row"
        .Tag = "My_Cell_Control_Tag"

        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "InsertRow"
            .FaceId = 1087
            .Caption = "Insert Row Above"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "InsertWeekend"
            .FaceId = 1087
            .Caption = "Insert Weekend Above"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "DeleteRow"
            .FaceId = 1088
            .Caption = "Delete This Row"
        End With
       
    'Add seperator to the Cell menu
    ContextMenu.Controls(9).BeginGroup = True
   
    Set MySubMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, Before:=9)

    With MySubMenu
        .Caption = "Floor/Asset Requests"
        .Tag = "My_Cell_Control_Tag"

        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "OpenFloorPlanRequestFill"
            .FaceId = 31
            .Caption = "Send Floor Plan Request"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "CancelFloorPlanRequest"
            .FaceId = 31
            .Caption = "Cancel Floor Plan Request"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "FloorPlanReceived"
            .FaceId = 31
            .Caption = "Floor Plan Received"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "UnreceiveFloorPlan"
            .FaceId = 31
            .Caption = "Unreceive Floor Plan"
        End With
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "SendAssetRequestEmail"
            .FaceId = 31
            .Caption = "Send Asset Request Email to Field Manager"
        End With
          
    End With

End With
    
End Sub

Here's how I call it:

VBA Code: 
Private Sub Workbook_Activate()
    Call AddToCellMenu
End Sub

Here's how I cancel it:

VBA Code: 
Sub DeleteFromCellMenu()
    Dim ContextMenu As CommandBar
    Dim ctrl As CommandBarControl

    'Set ContextMenu to the Cell menu
    Set ContextMenu = Application.CommandBars("Cell")

    'Delete 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

    'Delete built-in Save button
    On Error Resume Next
    'ContextMenu.FindControl(ID:=3).Delete
    On Error GoTo 0
End Sub

And here's how I call that:

VBA Code: 
Private Sub Workbook_Deactivate()
    Call DeleteFromCellMenu
    Application.CommandBars("Cell").Reset
End Sub
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
I ran Windows updates and Microsoft 365 updates this morning on the offending machine. Still no luck. No custom context menu on just this one machine.
 
Upvote 0
I spent the entire holiday weekend in a Chama, New Mexico sweat lodge in silent meditation. I mostly thought about my context menu problem.

After 48 straight hours (and just as delirium set in ) I saw the ghostly figure of a hooded shaman enter the tent. He slowly glided across the room towards me, seemingly without moving his legs.

As he neared me I fell to his feet and begged for the answer to my VBA dilemma. "How is it possible that every user has a right-click context menu except for one. Was this user impure? Was my code sullied?"

He looked me in the eye and with a quivering voice said "sorry, pal. I'm not an Excel guy."
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question Question
Overflowing menu bars
Replies
0
Views
257
Formula11
F
F
  • Solved
Context menu - from Addin
Replies
2
Views
725
Formula11
F
A
  • Question Question
Right Click Function error
Replies
1
Views
620
hajiali
H
C
  • Question Question
popup menu
Replies
3
Views
2K
KOKOSEK
KOKOSEK
J
  • Solved
Adding sub-menu groups to contect menu
Replies
4
Views
3K
jmpatrick
J

Forum statistics

Threads
1,223,880
Messages
6,175,154
Members
452,615
Latest member
bogeys2birdies

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top