Question

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

[EDIT]：我正在调试，并且在Application.CommandBars（“ cell”）。Controls.Count的所有模块和过程中添加了一个监视，出于某种不可思议的原因，只需在列表中为Application添加另一个相同的监视.CommandBars（“ cell”）。Controls.Count在中断模式下导致计数增加1。

每当我按F8键转到下一行时，即使由于由于某种原因未初始化objControl对象而引发错误，计数也会增加一个。请参阅下面的屏幕截图，以查看调试过程中看到的内容。突出显示的黄线对尚未初始化的对象抛出错误，并且每次我尝试执行该行时，Count都会增加1。

[EDIT 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属性，该属性返回内部编号。真正的问题是，这些数字因版本而异。我建议您在两种布局中添加菜单。为此，您需要遍历过滤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：自定义右键单击菜单选项不可见

1 个答案: