Deletar Formas de uma ActiveSheet

Question

Boa Noite Pessoal,

Mas uma vez venho pedir a ajuda de vocês para resolver um problema. Tenho uma planilha com vários shapes (formas, gráficos, botões, etc..) diferentes, gostaria que todas as formas fossem deletadas, exceto os botões que ativam as macros e alguns frames que servem como ilustração.

Alguém sabe alguma forma de resolver isso?

Desde já agradeço a colaboração de vocês.

Answer 1

Boa noite Lucas.

Sugiro a leitura do material: http://www.rondebruin.nl/win/s4/win002.htm

Está em inglês, mas creio que a leitura seja fácil.

---

Filipe Magno

Answer 2

Obrigado Felipe Magno,

Segundo o autor do Blog seria necessário usar duas rotinas:

A primeira identifica todos as formas utilizadas dentro da worksheet:

Sub ListAllObjectsActiveSheet()
    Dim NewSheet As Worksheet
    Dim MySheet As Worksheet
    Dim myshape As Shape
    Dim I As Long

    Set MySheet = Plan1
    Set NewSheet = Worksheets.Add

    With NewSheet
        .Range("A1").value = "Name"
        .Range("B1").value = "Visible(-1) or Not Visible(0)"
        .Range("C1").value = "Shape type"
        I = 2

        For Each myshape In MySheet.Shapes
            .Cells(I, 1).value = myshape.Name
            .Cells(I, 2).value = myshape.Visible
            .Cells(I, 3).value = myshape.Type
            I = I + 1
        Next myshape

        .Range("A1:C1").Font.Bold = True
        .Columns.AutoFit
        .Range("A1:C" & Rows.Count).Sort Key1:=Range("C1"), _
                        Order1:=xlAscending, Header:=xlYes
    End With

End Sub

Depois com todas as formas identificadas, você poderá utilizar esta macro para apagar somente as formas que você deseja:

Sub Deleta_Shapes()
'Dave Peterson and Bob Phillips
'Example only for the Forms controls
    Dim shp As Shape
    Dim testStr As String

    For Each shp In ActiveSheet.Shapes

        If shp.Type <> 8 And shp.Type <> 17 And shp.Type <> 13 Then
            If shp.FormControlType = 2 Then
                testStr = ""
                On Error Resume Next
                testStr = shp.TopLeftCell.Address
                On Error GoTo 0
                If testStr <> "" Then shp.Delete
            Else
                shp.Delete
            End If
        End If

    Next shp
End Sub

É importante lembrar que o bloco IF dentro da estrutura For Each, descarta os shapes tipo 2, estes shapes são os reponsáveis por filtros, listas de validação, etc...

Obrigado Filipe!