'----------------------------------------------------------------
Sub RemoveShapes()
'----------------------------------------------------------------
' Written by : Bob Phillips
' Inspired by: Debra Dalgleish & Dave Peterson
' Improved by: Dave Peterson (cater for forms combobox)
'---------------------------------------------------------------
' Synopsis: Checks each shape to be form control, and if it
' is a dropdown, it aims to retain it.
' One problem is that the forms combobox which is
' also a form control, and is a dropdown, so it
' does not get deleted.
'
' Catered for by testing top left of shape, as
' Autofilter and Data Validation dropdowns do not
' seem to have a topleftcell address.
'---------------------------------------------------------------
Dim shp As Shape
Dim sTopLeft As String
Dim fOK As Boolean

For Each shp In Worksheets("Form-99").Shapes

fOK = True

sTopLeft = ""
On Error Resume Next
sTopLeft = shp.TopLeftCell.Address
On Error GoTo 0

If shp.Type = msoFormControl Then
If shp.FormControlType = xlDropDown Then
If sTopLeft = "" Then
fOK = False 'keep it
End If
End If
ElseIf shp.Name = "Rectangle 7" Then '<=== change to suit
fOK = False
End If

If fOK Then shp.Delete

Next shp

End Sub

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)


"Rick_T" wrote in message
...
I have a worksheet that containes a number of shapes (pictures). The
number
could range from 1 to 30. I want to deleate all the shapes at one time
EXCEPT for one particular shape.
With the code below I can select all the shapes in the worksheet and
delete
them. The problem is it also deletes the one shape I want to retain.

Set myDocument = Worksheets("Form-99")
myDocument.Shapes.SelectAll
Set sr = Selection.ShapeRange
Selection.Cut

I tried setting a range of column Q; all the shapes I want to delete are
in
the Q column but there is also data in the column I don't want to delete,
I
only want to remove the shapes. The problem is that this method only
deletes
one shape for each time it runs, it doesn't delete all the shapes with one
run cycle. I tried deleteAll with the range code but it didn't work.
Thanks
for any help you can offer.

Sheets("Form-99").Select
ActiveSheet.Shapes("Signature").Select
ActiveSheet.Shapes.Range(Array("Q8:Q74")).Select
Selection.Cut
--
Rick