Erase All shapes, lines, Boxes

[daniels012]

I know someone has written about erasing buttons and not objects.
I want to do just the opposite. I would like to erase all the arrows, boxes, circles, etc. at once through code. How could I do this??

Thank You,
Michael

 

[jdc]

Hi

Would this be what you are looking for

Code ***************

Sub DeleteShapes()
For Each c In ActiveSheet.Shapes
c.Select
Selection.Delete
Next c
End Sub

********************

I am not sure just how much it will delete, it will remove Command buttons,

John

 

[Glaswegian]

Try this

Sub EraseDrawings()
Dim mySht As Worksheet

Set mySht = Worksheets("Sheet1")
mySht.Shapes.SelectAll
Selection.Delete

End Sub
Sub AddaDate()

It will delete ALL shapes including Control Toolbox items.

Regards

 

[daniels012]

You were right it deleted everything.
I created a button with my macro in it, and sure enough away it went with everything else.

I wonder if there is a way?
Michael

 

[Glaswegian]

Michael

Draw a Forms button on your sheet and assign your macro. Then try this code - amend the button name to that of your button - look in the names box just above column A for the name when you right click the button.

Sub EraseDrawings()
Dim mySht As Worksheet
Dim sh As Shape

Set mySht = Worksheets("Sheet1")
For Each sh In mySht.Shapes
If sh.Name <> "Button 1" Then
sh.Delete
End If
Next sh
End Sub

Regards

 

[daniels012]

Yes that worked GREAT!! Thank You sooooooo much.
I had it all set up and it wasn't working?? I thought why is this not working? I went to the code and realized it was for "Sheet 1". As soon as I changed to my sheets name, It worked perfectly.

Thank You,
Michael

 

[daniels012]

Instead of Deleting, Can I count all the shapes except the button to execute the Macro?

What would I add or write??

Thank You,
Michael

 

[Glaswegian]

Hi Michael

Would this do? Just a simple count less the one for your button.

Sub CountDrawings()
Dim mySht As Worksheet

Set mySht = Worksheets("Sheet1")
MsgBox "Found " & (mySht.Shapes.Count - 1) & " shapes!"
End Sub


Regards