Your ActiveDocument.Select line is selecting everything so any subsequent code would apply to the whole document. Perhaps you are looking for something along the following lines.
Code:
Sub DeleteShapes()
Do While Selection.Range.ShapeRange.Count > 0
Selection.Range.ShapeRange(1).Delete
Loop
End Sub