尝试从一系列单元格中删除按钮时 Excel VBA 错误 1004

Question

我在删除一系列包含 ActiveX 命令按钮的单元格时遇到问题，因为下面的代码在调试时会在相交部分抛出错误 1004“应用程序定义或对象定义错误”。

Sub DeleteShapes() 
    Dim rng As Range
    Dim sh As Shape
    Set rng = Range("I7:K61")

    With Sheets("ADB")
        For Each sh In .Shapes    
            If Not Intersect(sh.TopLeftCell, .Range(rng)) Is Nothing Then
                sh.Delete
            End If
        Next
    End With
End Sub

工作表未锁定，我确保范围内的所有单元格也未锁定。也没有合并的单元格。我尝试了其他代码组合，但仍然导致错误 1004。代码在模块中。

奇怪的是，如果我添加代码来忽略错误，它会毫无问题地删除按钮。但是，出现了一个奇怪的问题，其中数据验证的下拉框在删除按钮后无法显示。它显示的唯一方法是保存工作簿。保存后删除按钮会导致下拉菜单再次消失。

有什么解决办法吗？

编辑：看起来我正在体验某种基于 VBasic2008 代码的类型为 8 的“幻影下拉”对象。我创建了一个新工作表并尝试复制一些旧工作表，然后它再次存在。 进一步的实验表明它来自我的数据验证单元格。然而奇怪的是，删除数据验证并不会删除下拉对象。清除整个工作表会导致对象仍然存在。我不得不删除工作表以摆脱它..

数据验证是否被视为表单控件？不应该……对吧？

编辑：我如何生成按钮

Public Sub GenerateButtons()
 Dim i As Long
 Dim shp As Object
 Dim ILeft As Double
 Dim dblTop As Double
 Dim dblWidth As Double
 Dim dblHeight As Double
 Dim lrow As Long

 lrow = Cells(Rows.count, 1).End(xlUp).Row

 With Sheets("ADB")
     ILeft = .Columns("I:I").Left      
     dblWidth = .Columns("I:I").Width    
     For i = 7 To lrow                      
         dblHeight = .Rows(i).Height     
         dblTop = .Rows(i).Top         
         Set shp = .Buttons.Add(ILeft, dblTop, dblWidth, dblHeight)
         shp.OnAction = "Copy1st"
         shp.Characters.Text = "Copy " & .Cells(i, 6).Value
     Next i
 End With

 End Sub

Answer 1

形状

在 VBE 的对象浏览器中搜索 msoShapeType，您会注意到 有几种形状类型。在你的情况下可能：

msoFormControl (8) - 下拉菜单
msoOLEControlObject (12) - 按钮和东西。

无论如何，请先尝试此代码以确定您要删除的内容。

Sub ShapeTypes()

  Dim shshape As Shape

  Const c1 = " , "
  Const r1 = vbCr
  Dim str1 As String

  str1 = "Shape Types in ActiveSheet"
  For Each shshape In ActiveSheet.Shapes
    str1 = str1 & r1 & Space(1) & shshape.Name & c1 & shshape.Type
  Next
  Debug.Print str1

End Sub

以下代码删除 ActiveSheet 上的所有 msoOLEControlObject 类型的形状（我假设您要删除）：

Sub ShapesDelete()

  Dim shshape As Shape

  For Each shshape In ActiveSheet.Shapes
    If shshape.Type = 12 Then
      shshape.Delete
    End If
  Next

End Sub

最后是你的代码：

Sub DeleteShapes()

    Const cStrRange As String = "I7:K61"
    Const cStrSheet As String = "ADB"

    Dim sh As Shape

    With Sheets(cStrSheet)
        For Each sh In .Shapes
            If sh.Type = 12 Then 'or msoOLEControlObject
                On Error Resume Next
                If Intersect(sh.TopLeftCell, .Range(cStrRange)) Then
                    If Not Err Then
                        sh.Delete
                    End If
                End If
            End If
        Next
    End With

End Sub

我还没有弄清楚错误背后的原因，但是它已经被处理并且所有的按钮都被删除了。

新版本：

Sub DeleteShapes()

    Const cStrRange As String = "I7:K61"
    Const cStrSheet As String = "ADB"

    Dim sh As Shape

    With Sheets(cStrSheet)
        For Each sh In .Shapes
            If sh.Type = 8 Then 'or msoFormControl
                On Error Resume Next
                If Not Intersect(sh.TopLeftCell, .Range(cStrRange)) Is Nothing Then
                    If Left(sh.Name,4) = "Butt" then  
                        sh.Delete
                    End If
                End If
            End If
        Next
    End With

End Sub

由于 WRONG 拦截行导致错误，因此无需进行错误处理。