Reputation: 1651
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
Upvotes: 1
Views: 4957
Reputation: 52008
Try this. Note the inclusion of the word "False":
Public Sub ShapeSelection()
Dim Sh As Shape
Dim selectedOne As Boolean
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
If selectedOne = False Then
Sh.Select
selectedOne = True
Else
Sh.Select(False)
End If
End If
Next Sh
End With
Application.ScreenUpdating = True
End If
End Sub
Upvotes: 1