TCN
TCN

Reputation: 1651

How to select multiple shapes based on range?

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

Answers (1)

John Coleman
John Coleman

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

Related Questions