0

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

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

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

在此处输入图像描述

4

1 回答 1

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
于 2018-12-05T18:10:51.557 回答