Question

我正在尝试选择范围内的形状，但代码的结果并不完全符合我的预期。它会随机选择比预期更多的形状（不在范围内）。

Public Sub ShapeSelection()
Dim Sh As Shape
Dim selectedOne As Boolean
On Error Resume Next

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
End Sub

Answer 1

奇怪的行为是由“Selection.Address”引起的

在你的循环中，当找到第一个形状时，你可以将当前选择从范围C3更改为第一个形状

下一次循环时，它试图将TopLeftCell的地址与形状对象的地址进行比较（交叉）：形状对象本身没有地址（其TopLeftCell有一个）

但你走的很远：你不需要使用交叉。代码如下所示：

Option Explicit

Public Sub ShapeSelection()

    Dim Sh As Shape
    Dim sRng As Range

    With ActiveSheet
        Set sRng = Selection
        For Each Sh In .Shapes
            If Sh.TopLeftCell.Address = sRng.Address Then
                Sh.Select
                Exit For
            End If
        Next Sh
    End With
End Sub

修改：我刚刚注意到您之前的问题：How to select multiple shapes based on range?

需要交叉才能完成该要求，但您仍需要保留对所选单元格的引用：

Option Explicit

Public Sub ShapeSelection()

    Dim Sh As Shape
    Dim sRng As Range

    With ActiveSheet
        If TypeName(Selection) = "Range" Then
            Set sRng = Selection
            If sRng.CountLarge = 1 Then
                For Each Sh In .Shapes
                    Sh.Select False
                Next Sh
            Else
                For Each Sh In .Shapes
                    If Not Application.Intersect(Sh.TopLeftCell, .Range(sRng.Address)) Is Nothing Then
                        Sh.Select False
                    End If
                Next Sh
            End If
        End If
    End With
End Sub

选择范围内的形状。奇怪的看似随意的结果？

1 个答案: