Удалить Specifi c Shapes с листа

Question

Hy, у меня есть книга Excel, состоящая из листа Excel, который содержит изображения, фигуры, стрелки и многие другие фигуры. Структура листа выглядит так.

введите описание изображения здесь На картинке выше я обведу все текстовые поля, стрелки, овелы, фигуры, которые я хочу удалить. Я написал код для удаления текстовых полей, которые проверяют наличие текстовых полей и, если они найдены, удаляют их. С другой стороны, если не существует всплывающего окна, то текстовое поле не существует. Код такой же.

    Sub resetall()
Dim ws As Worksheet
Dim arow As Shapes
Dim txtbox As TextBox
Set ws = ActiveSheet
If ws.TextBoxes.Count < 0 Then
MsgBox "No Text Box Exist."
Exit Sub
End If
ws.TextBoxes.Delete
MsgBox "Text Box has been deleted successfully."
End Sub

Этот код работает нормально, но я не смог найти код для стрелок, овальных форм и кругов. Пожалуйста, проверьте мой код и помогите мне. Я пробовал использовать формы. Овальная ссылка из библиотеки, но не удалось. Пожалуйста, направь меня. Спасибо.

Answer 1

https://www.thespreadsheetguru.com/the-code-vault/vba-delete-all-shapes

Sub DeleteAllShapes()
'PURPOSE: Remove All Shape Objects From The Active Worksheet
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim shp As Shape

For Each shp In ActiveSheet.Shapes
   shp.Delete
Next shp

End Sub

При желании добавьте тест внутри l oop для указанного c типа из msoShapeType

Answer 2

Попробуйте следующий код, пожалуйста:

Sub DeleteallShapesExceptRect()
 Dim ws As Worksheet, s As Shape, boolRect As Boolean

 Set ws = ActiveSheet
 For Each s In ws.Shapes
    If s.Type = msoAutoShape Then
        If s.AutoShapeType = msoShapeRectangle Then
           boolRect = True
        End If
    End If
    If Not boolRect Then s.Delete
    boolRect = False
Next

Следующий вариант исключает любой тип фигуры Rectangle:

Sub DeleteallShapesExceptAllRect()
 Dim ws As Worksheet, s As Shape, boolRect As Boolean

 Set ws = ActiveSheet
 For Each s In ws.Shapes
    If s.Type = msoAutoShape Then
        If s.AutoShapeType = msoShapeRectangle Or _
                msoShapeRoundedRectangle Or msoShapeRound1Rectangle Or _
                                        msoShapeSnip2DiagRectangle Then
           boolRect = True
        End If
    End If
    If Not boolRect Then s.Delete
    boolRect = False
 Next
End Sub

Следующий вариант удаляет все фигуры из указанного c диапазона :

Sub DeleteAllShapesOnRange()
 Dim ws As Worksheet, s As Shape, rngDel As Range

 Set ws = ActiveSheet: Set rngDel = ws.Range("A1:W6")
 For Each s In ws.Shapes
    If Not Intersect(rngDel, s.TopLeftCell) Is Nothing Then
        s.Delete
    End If
 Next
End Sub

И следующий удаляет все формы, которые Not в указанном c диапазоне:

Sub DeleteAllShapesNotOnRange()
 Dim ws As Worksheet, s As Shape, rngNoDel As Range, boolFound As Boolean

 Set ws = ActiveSheet: Set rngNoDel = ws.Range("A1:W6")
 For Each s In ws.Shapes
    If Not Intersect(rngNoDel, s.TopLeftCell) Is Nothing Then
        boolFound = True
    End If
    If Not boolFound Then s.Delete
 Next
End Sub

И, наконец, версия, удаляющая все фигуры без текста:

Sub DeleteAllShapesNotHavingText()
 Dim ws As Worksheet, s As Shape, boolFound As Boolean

 Set ws = ActiveSheet
 For Each s In ws.Shapes
    If Not Len(s.TextFrame2.TextRange.Text) = 0 Then
        boolFound = True
    End If
    If Not boolFound Then s.Delete
 Next
End Sub

Примечание: Каждый такой код может запрашивать разрешение перед удалением, но это не будет иметь большого значения между ручное удаление и одно, выполненное в коде ... Если вы настаиваете на таком условии, укажите, какую из вышеперечисленных версий нужно адаптировать.

В любом случае, следующий Sub возвращается (в окне немедленного доступа) все (упомянутые) формы типа. Вы можете изменить их имена. Следующий код проверяет их реальный тип, который возвращается как Long:

Sub EnumerateShapesType()
 Dim ws As Worksheet, s As Shape, boolRect As Boolean, arrS As Variant, arrEl As Variant, El As Variant
 arrS = Split("Rectangle|1,Round Rectangle|5,Oval|9,Right Arrow|33,Down Arrow|36", ",")

 Set ws = ActiveSheet
 For Each s In ws.Shapes
    If s.Type = msoAutoShape Then
        For Each El In arrS
            If s.AutoShapeType = Split(El, "|")(1) Then
                Debug.Print s.Name, Split(El, "|")(0): Exit For
            End If
        Next
    End If
 Next
End Sub

Answer 3

Ответ Office 365:

• Go на вкладку «Главная»
• Go для поиска и выбора
• Go на панель выбора

Теперь у вас есть имена фигур на вашем листе.

В качестве примера вы можете использовать ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 1")).Delete для удаления одного элемента.