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

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

0 голосов
/ 05 декабря 2018

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

[РЕДАКТИРОВАТЬ]: Я отлаживаю и добавил часы для всех модулей и процедур для Application.CommandBars ("ячейка"). Controls.Count и по какой-то невероятной причине, просто добавив еще одно идентичное часыв список, для Application.CommandBars ("ячейка"). 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

enter image description here

1 Ответ

0 голосов
/ 05 декабря 2018

Проблема в том, что есть два меню 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
...