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