none
Deletar Formas de uma ActiveSheet RRS feed

  • Pergunta

  • 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.

    terça-feira, 31 de maio de 2016 01:23

Respostas

  • 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!

    terça-feira, 31 de maio de 2016 11:02

Todas as Respostas

  • 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

    terça-feira, 31 de maio de 2016 01:38
  • 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!

    terça-feira, 31 de maio de 2016 11:02