VBA Excel выбрать и удалить все фигуры с одинаковым идентификатором и удалить

Question

Я хотел бы удалить все фигуры с моего листа. У них одинаковый идентификатор.

Я нашел два кода:

Первый:

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

не работает. Нет ошибок, но и вообще никакой реакции.

Второй: Выбор фигуры в Excel с VBA

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

работает, но удаляет только одну одним элементом. В моем случае все элементы имеют идентификатор "Firestop". Я хотел бы, чтобы все они были удалены сразу. Как я могу это сделать?

Answer 1

Проблема в том, что If TypeName(Application.Selection) = "Firestop" Then никогда не бывает правдой. Взгляните на функцию TypeName не возвращает имя Application.Selection, но вместо этого возвращает значение type Application.Selection. Здесь, вероятно, возвращается Object, потому что фигура является объектом.

На самом деле имена являются уникальными. Вы не можете добавить 2 фигуры с одинаковыми именами. Вот почему ActiveSheet.Shapes("Firestop").Delete удаляет только одну фигуру.

Кажется, есть ошибка, что при копировании именованной фигуры существуют 2 фигуры с одинаковыми именами (что не должно быть возможным). Вы можете обойти это, удалив эту фигуру в al oop, пока не получите ошибку (фигура с таким именем не останется).

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