Search code examples
vbacontrolsuser-defined-functionscommandbar

VBA: Custom Right Click Menu Option Isn't Visible


I am trying to create an option that allows the user to remove data validation from a cell via the right click menu option. So far, the code is compiling and executing without errors. It is succesfully adding the custom control to the collection Commandbars("cell").Controls. It also has the correct tag and the correct OnAction value. But for some reason it is not appearing in the right click menu. I copied and pasted this code from another project I did, and it still runs fine in the other excel workbook. All I changed was the caption and the OnAction strings. I am baffled by this. Any help is greatly appreciated. Code below.

[EDIT]: I am debugging and I added a watch across all modules and procedures for Application.CommandBars("cell").Controls.Count and for some incredible reason, simply adding another identical watch to the list, for Application.CommandBars("cell").Controls.Count, in break mode, caused the count to increase by 1.

The count also goes up by one each time I press F8 to step to the next line, even when an error is thrown due to the objControl object not being initialized for some reason. See screenshot below to see what I saw during debugging. The highlighted yellow line is throwing an error for an object that hasn't been initialized yet, and each time I try to execute that line, the Count increases by 1.

[EDIT 2]: Apparently adding a watch for literally anything, even while in break mode, causes the count to increase by 1. I have no idea how or why.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim objControl As Object, sum As Double, vCell As Variant, fieldtype As Integer
Dim tagArr() As String, i As Integer
If Target.Count > 1 And Target.MergeCells = False Then GoTo lbl_Exit
If Intersect(Target, Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing 
Then GoTo lbl_Exit
ReDim tagArr(0)
tagArr(0) = "brccm"
i = 0
For i = 0 To UBound(tagArr)
    For Each objControl In Application.CommandBars("cell").Controls
        If objControl.Tag = "" Then objControl.Delete
        If tagArr(i) = objControl.Tag Then
            objControl.Delete
            GoTo lbl_Deleted
        End If
lbl_Next:
    Next objControl
lbl_Deleted:
Next i
i = 0
If Target.row < 83 And Target.Column < 14 Then 'the active area for the order form
    'If Not Intersect(ActiveSheet.Cells.SpecialCells(xlCellTypeAllValidation), Target) Is Nothing Then 'if cell has any validation settings at all
        capture_target_range Target
        'For i = 0 To UBound(tagArr)
        With Application.CommandBars("cell").Controls.Add(Type:=msoControlButton, before:=1, temporary:=True)
            .Tag = tagArr(0)
            .Caption = "Clear data validation restrictions from cell"
            .OnAction = "'RightClick_ClearValidation'"
        End With
End If
Exit Sub
lbl_Exit:
On Error Resume Next
i = 0
For Each objControl In Application.CommandBars("cell").Controls
    For i = 0 To UBound(tagArr)
        If objControl.Tag = tagArr(i) Then objControl.Delete
    Next i
Next objControl
End Sub

enter image description here


Solution

  • The problem is that that there are two CELL menus: 1) in Normal layout and 2) Page layout. Switching to either layout affects menu visibility - this means that if you create menu in Normal layout, you won't see it in Page layout - and vice versa.

    You can ensure that there are two CELL menus by running the following code:

    Sub ListCommandBars()
        Dim r%, cmb As CommandBar
        For Each cmb In CommandBars
            r = r + 1
            Cells(r, 1) = cmb.Name
        Next
        [A1].CurrentRegion.Sort Key1:=[A1]
    End Sub
    

    To differentiate one from another, you can use their Index property which returns internal number. The real problem is that these numbers are different from version to version. I advise you to add your menu in both layouts. For it you need to iterate over all command bars filtering CELL menu:

    Sub AddMenu2()
        Dim cmb As CommandBar
        For Each cmb In CommandBars
            If cmb.Name = "Cell" Then
                '// Add your menu here
            End If
        Next
    End Sub