Is there a way to delete shapes/objects from a preselected area? I am trying
to use the following macro, but it takes a long time. It also has the
problem as you can't tell which object is selected when the dialog box is
open. There are too many objects to manually select and delete.
Tim

Sub delete_objects_in_an_area()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
shp.Select 'can't determine which shape is selected
'ActiveSheet.activeShape.Select
'need to select shape first so I know whether to delete or not
response = MsgBox("Delete shape?", vbYesNoCancel + vbCritical +
vbDefaultButton2)
If response = vbYes Then
shp.Delete
ElseIf response = vbCancel Then
Exit Sub
End If
Next
end su

This code will delete shapes within a range of selected cells.

Sub test()
Const cDeleteOnTouch As Boolean = False
Dim rng As Range, shp As Shape, rngSelect As Range, blnDelete As Boolean

Set rngSelect = Selection

For Each shp In ActiveSheet.Shapes
blnDelete = False
Set rng = Intersect(Range(shp.TopLeftCell, shp.BottomRightCell),
rngSelect)
If cDeleteOnTouch Then
If Not rng Is Nothing Then blnDelete = True
Else
If Not rng Is Nothing Then
If rng.Address = Range(shp.TopLeftCell,
shp.BottomRightCell).Address Then blnDelete = True
End If
End If

If blnDelete Then MsgBox "delete " & shp.Name
Next
End Sub


--
Rob van Gelder - http://www.vangelder.co.nz/excel


"Tim" wrote in message
...
Is there a way to delete shapes/objects from a preselected area? I am
trying
to use the following macro, but it takes a long time. It also has the
problem as you can't tell which object is selected when the dialog box is
open. There are too many objects to manually select and delete.
Tim

Sub delete_objects_in_an_area()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
shp.Select 'can't determine which shape is selected
'ActiveSheet.activeShape.Select
'need to select shape first so I know whether to delete or not
response = MsgBox("Delete shape?", vbYesNoCancel + vbCritical +
vbDefaultButton2)
If response = vbYes Then
shp.Delete
ElseIf response = vbCancel Then
Exit Sub
End If
Next
end su