If the selected range is composed of 1 cell then select all shapes in the sheet, else select the shapes in the range. It's the "else" part that's giving me trouble. I can select one shape, but not all shapes in the range...
Public Sub ShapeSelection()
Dim Sh As Shape
On Error Resume Next
If Selection.Rows.count * Selection.Columns.count = 1 Then
ActiveSheet.Shapes.SelectAll
Else
Application.ScreenUpdating = False
With ActiveSheet
For Each Sh In .Shapes
If Not Application.Intersect(Sh.TopLeftCell, .Range(Selection.Address)) Is Nothing Then
Sh.Select
End If
Next Sh
End With
Application.ScreenUpdating = True
End If
End Sub
Try this. Note the inclusion of the word "False":