VBA根据其位置选择形状

Question

如何选择单元格"A:Shape.TopLeftCell.Row" = 0中所有形状（数组？范围？）？

数组应仅包含形状2和3，如上图所示。

Answer 1

构建符合条件的 ShapeRange ，然后选择 ShapeRange

Sub ShapePicker()
    Dim s As Shape, sr As ShapeRange
    Dim Arr() As Variant
    Set mycell = Range("A:A").Find(What:=0, After:=Range("A1"))
    rrow = mycell.Row

    i = 1
    For Each s In ActiveSheet.Shapes
        If s.TopLeftCell.Row = rrow Then
            ReDim Preserve Arr(1 To i)
            Arr(i) = s.Name
            i = i + 1
        End If
    Next s

    Set sr = ActiveSheet.Shapes.Range(Arr)
    sr.Select

End Sub

Answer 2

作为替代方案，您可以反转逻辑并随意选择，然后根据需要将选择分配给shaperange：

Sub ShapePicker()
    Dim s As Shape
    Dim sr As ShapeRange
    Dim i As Long

    i = 1
    For Each s In ActiveSheet.Shapes
        If Cells(s.TopLeftCell.Row, "A").Value = 0 Then
            s.Select (i = 1)
            i = i + 1
        End If
    Next s
    Set sr = Selection.ShapeRange
End Sub

Answer 3

您可以遍历图纸上的形状，直到找到该范围内的形状为止。正如其他人所述，选择通常是不必要的。

Dim shp As shape
For Each shp In ActiveSheet.shapes
    If Not Intersect(yourselectedrange, shp.TopLeftCell) Is Nothing Then
         shp.Select
         Exit For
    End If
Next shp

Answer 4

还有另一种解决方法。我在寻找解决方案时碰到了这篇文章。

因此，这里是Answer，适合任何想找路的人。

方法如下：

像这样运行loop一次，将Rectangles的名称更改为其TopLeftCell的地址

 Dim sh As Shape

 For Each sh In ActiveSheet.Shapes

    sh.Name = sh.TopLeftCell.Address

 Next sh

---

现在，您可以使用以下任何其他代码直接访问形状：

ActiveSheet.Shapes(ActiveCell.Address).Select

这是实现它的一种方法。尽管不存在您要寻找的方法。

您可以更改ActiveCell.Address的任何范围对象，也可以仅更改文本本身。它将采用$D$4

之类的值

经过测试，可以顺利运行。