VBA根据位置选择形状答案

【问题标题】：VBA select shapes based on their positionsVBA根据位置选择形状
【发布时间】：2014-06-18 14:24:25
【问题描述】：

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

阵列应仅包含上图所示的形状 2 和 3。

【问题讨论】：

您实际上想要完成什么？我问这个，因为在 Excel 中很少需要 Select 或 Activate 任何东西。
另外，这没有任何意义："A:Shape.TopLeftCell.Row" = 0.
当然不是。这是为了表明我需要以这样一种方式放置的形状，即它们的左上角在一行中，其中列 A 值 = 0。
选择我的意思是放入一个数组，然后我将对所有这些进行一些更改
好的。那么到目前为止你尝试了什么？您可以创建一个返回形状名称数组的函数。

【解决方案1】：

作为替代方案，您可以反转逻辑并随时选择，然后根据需要将选择分配给 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

【讨论】：

正是我需要的。谢谢

【解决方案2】：

构建一个满足条件的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

【讨论】：

【解决方案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

【讨论】：

【解决方案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 之类的值

久经考验，运行顺畅。

【讨论】：