Notifications
Clear all

Excluir shapes

3 Posts
1 Usuários
0 Reactions
1,640 Visualizações
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Boa noite!

Há um caminho para exluir todos os shapes de uma planilha, sem excluir os macros existentes?
Já me passaram a rotina abaixo, porém, ela também exclui os macros:

Public Sub DeleteShapes()

Dim oShape As Shape
Dim oActive As Worksheet

Set oActive = ActiveSheet

'Deleta os shapes existentes
For Each oShape In oActive.Shapes
oShape.Delete
Next

End Sub

Obrigado!

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 06/02/2012 5:35 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Boa noite!!!

Não se vai te ajudar, tente e dê retorno.
Font: Ozcrid

Option Explicit 
 
Public g_colMyShapes As Collection 
Public g_blnCreatedCollection As Boolean 
Public Sub AddMyShapes() 
    ' Add shapes 
    Dim objTemp As Shape 
    Dim intIndex As Integer 
    Dim lngX As Long 
     
    If Not g_blnCreatedCollection Then 
        ' create a collection For the shapes 
        Set g_colMyShapes = New Collection 
        g_blnCreatedCollection = True 
    End If 
     
    lngX = 10   ' position 
    For intIndex = 1 To 5 
        ' add shape. Modify To suit your preference 
        Set objTemp = ActiveSheet.Shapes.AddShape(msoShapeOctagon, lngX, 80, 50, 50) 
        ' add shape To collection 
        g_colMyShapes.Add objTemp, CStr(g_colMyShapes.Count + 1) 
        lngX = lngX + 60    ' move over so shapes don't overlap 
        If intIndex > 2 Then 
            ' change sheet after 3rd shape 
            Sheet2.Select 
        End If 
    Next 
     
End Sub 
 
Public Sub DeleteMyShapes() 
     
    Dim strSheetname As String 
    Dim strShapeName As String 
     
    Do While g_colMyShapes.Count > 0 
        ' get shape name And the sheet it Is on 
        strSheetname = g_colMyShapes.Item(g_colMyShapes.Count).Parent.Name 
        strShapeName = g_colMyShapes.Item(g_colMyShapes.Count).Name 
        ' delete shape 
        Sheets(strSheetname).Shapes(strShapeName).Delete 
        ' delete item from collection 
        g_colMyShapes.Remove g_colMyShapes.Count 
    Loop 
    ' clear memory 
    Set g_colMyShapes = Nothing 
    g_blnCreatedCollection = False 
End Sub 

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 06/02/2012 5:47 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

porém, ela também exclui os macros:

Soares, os "botões" vinculados à macros, tambem são shapes, então para não exclui-los, é necessario informar à rotina que (por exemplo) "formas" cujo nome "são diferentes de" ; então o codigo poderá ser :

Public Sub DeleteShapes()

Dim oShape As Shape
Dim oActive As Worksheet

Set oActive = ActiveSheet

'Deleta os shapes existentes
For Each oShape In oActive.Shapes
   [color=#FF0000] If oShape.Name <> "Button*" Then[/color]
        oShape.Delete
    Else
        'MsgBox "A Forma tem o nome de:=  " & oShape.Name
    End If
Next
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 07/02/2012 5:59 am