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而是它returs类型是什么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

Answer 2

不建议经常使用On Error Resume Next 。 我们建议仅在不可缺少的情况下使用它。

Sub test()
    Dim shp As Shape
    Dim Ws As Worksheet

    Set Ws = ActiveSheet
    For Each shp In Ws.Shapes
        If shp.Name = "Firestop" Then
            shp.Delete
        End If
    Next shp
End Sub