How to select multiple shapes based on range?

2019-08-13 02:57发布

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

1条回答
Deceive 欺骗
2楼-- · 2019-08-13 03:33

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
查看更多
登录 后发表回答