VBA: 自定义右键单击菜单选项不可见

Question

我正在尝试创建一个选项，允许用户通过右键单击菜单选项从单元格中删除数据验证。至此，代码编译执行无误。它成功地将自定义控件添加到 collection Commandbars("cell").Controls。它还具有正确的标记和正确的 OnAction 值。但由于某种原因，它没有出现在右键菜单中。我从我做的另一个项目复制并粘贴了这段代码，它在另一个 excel 工作簿中仍然运行良好。我所更改的只是标题和 OnAction 字符串。我对此感到困惑。任何帮助是极大的赞赏。下面的代码。

[编辑]：我正在调试，我在 Application.CommandBars("cell").Controls.Count 的所有模块和过程中添加了一个监视，并且出于某些令人难以置信的原因，只需添加另一个与列表相同的手表，对于 Application.CommandBars("cell").Controls.Count，在中断模式下，导致计数增加 1。

每次我按 F8 进入下一行时计数也会增加一个，即使由于 objControl object 由于某种原因未初始化而引发错误也是如此。请参阅下面的屏幕截图，了解我在调试过程中看到的内容。突出显示的黄线为尚未初始化的 object 抛出错误，每次我尝试执行该行时，计数都会增加 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

Answer 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 属性其中 returns 内部编号。真正的问题是这些数字因版本而异。我建议您在两种布局中添加菜单。为此，您需要遍历所有过滤 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

VBA: 自定义右键单击菜单选项不可见

VBA: Custom Right Click Menu Option Isn't Visible

vba

controls

user-defined-functions

commandbar