VBA Excel 选择并删除所有具有相同 ID 的形状并删除

Question

我想从我的工作表中删除所有形状。他们有相同的ID。

我找到了两个代码：

第一个：

Public Sub ActiveShapes()
    Dim ShpObject As Variant

    If TypeName(Application.Selection) = "Firestop" Then
        Set ShpObject = Application.Selection
        ShpObject.Delete
    Else
        Exit Sub
    End If
End Sub

不管用。没有错误，但也完全没有反应。

第二种： 用VBA在Excel中选择一个形状

 Sub Firestopshapes()
     ActiveSheet.Shapes("Firestop").Delete
 End Sub

有效，但只删除一个元素。就我而言，所有元素都具有“Firestop”ID。我想让它们一次全部删除。我怎样才能做到这一点？

Answer 1

问题是If TypeName(Application.Selection) = "Firestop" Then这从来都不是真的。看看TypeName 函数不返回的名称，Application.Selection而是返回什么类型 Application.Selection。在这里它可能会返回，Object因为形状是一个对象。

其实名字是独一无二的。您不能添加 2 个具有相同名称的形状。这就是为什么ActiveSheet.Shapes("Firestop").Delete只删除一个形状。

似乎有一个错误，当您复制命名形状时，存在 2 个具有相同名称的形状（这应该是不可能的）。您可以通过在循环中删除该形状来解决此问题，直到出现错误为止（没有留下具有该名称的形状）。

On Error Resume Next
Do
    ActiveSheet.Shapes("Firestop").Delete
    If Err.Number <> 0 Then Exit Do
Loop
On Error GoTo 0 'don't forget this statement after the loop