形状

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的代码使用Type 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 拦截行引起了错误，因此无需进行错误处理。

尝试从单元格区域中删除按钮时，Excel VBA错误1004

1 个答案:

形状