VBA: пользовательский пункт меню правой кнопки мыши не виден

Я пытаюсь создать опцию, которая позволяет пользователю удалить проверку данных из ячейки с помощью правой кнопки меню. Пока что код компилируется и выполняется без ошибок. Он успешно добавляет пользовательский элемент управления в коллекцию Commandbars("ячейка"). Он также имеет правильный тег и правильное значение OnAction. Но по какой-то причине он не появляется в меню правой кнопки мыши. Я скопировал и вставил этот код из другого проекта, который я сделал, и он все еще отлично работает в другой книге Excel. Я изменил только заголовок и строки OnAction. Я сбит с толку этим. Любая помощь с благодарностью. Код ниже.

[РЕДАКТИРОВАТЬ]: Я отлаживаю и добавил наблюдение за всеми модулями и процедурами для Application.CommandBars("ячейка").Controls.Count и по какой-то невероятной причине, просто добавив еще одно идентичное наблюдение в список, для Application.CommandBars("cell").Controls.Count в режиме останова увеличил счет на 1.

Счетчик также увеличивается на единицу каждый раз, когда я нажимаю клавишу F8, чтобы перейти к следующей строке, даже если выдается ошибка из-за того, что объект objControl по какой-то причине не инициализируется. Смотрите скриншот ниже, чтобы увидеть то, что я увидел во время отладки. Подсвеченная желтая линия вызывает ошибку для объекта, который еще не был инициализирован, и каждый раз, когда я пытаюсь выполнить эту строку, счетчик увеличивается на 1.

[РЕДАКТИРОВАТЬ 2]: Очевидно, добавление часов буквально для чего угодно, даже в режиме перерыва, приводит к увеличению счетчика на 1. Я понятия не имею, как и почему.

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

1 ответ

Решение

Проблема в том, что есть два меню CELL: 1) в нормальном макете и 2) макет страницы. Переключение на любой макет влияет на видимость меню - это означает, что если вы создадите меню в обычном макете, вы не увидите его в макете страницы - и наоборот.

Вы можете убедиться, что есть два меню CELL, запустив следующий код:

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

Чтобы отличить одно от другого, вы можете использовать их Index свойство, которое возвращает внутренний номер. Реальная проблема заключается в том, что эти цифры отличаются от версии к версии. Советую добавить свое меню в обе раскладки. Для этого вам нужно перебрать все команды фильтрации меню CELL:

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
Другие вопросы по тегам