VBA 根据位置选择形状
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/24288149/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA select shapes based on their positions
提问by Ivan Fazaniuk
How do I select all shapes (array? range?) where the value in Cell "A:Shape.TopLeftCell.Row" = 0?
如何选择 Cell 中的值的所有形状（数组？范围？）"A:Shape.TopLeftCell.Row" = 0？
The Array should consist only Shapes 2 and 3 as per image above.
数组应仅包含形状 2 和 3，如上图所示。
回答by Rory
Just as an alternative, you can reverse the logic and select as you go, then assign the selection to a shaperange if required:
作为替代方案，您可以颠倒逻辑并随时选择，然后根据需要将选择分配给一个形状范围：
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
回答by Gary's Student
Build a ShapeRangethat meets the criteria and then Select that ShapeRange
构建符合条件的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
回答by Brian Dias
You can loop through the shapes on the sheet until you find one in the range. As someone else mentioned, selecting is often unnecessary.
您可以遍历工作表上的形状，直到在范围内找到一个。正如其他人提到的，选择通常是不必要的。
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
回答by Mikku
There is another way around of this. I came across this post while looking for a solution.
还有另一种方法可以解决这个问题。我在寻找解决方案时遇到了这篇文章。
So here it is the Answerfor anyone looking for a way around.
所以这里是任何寻找解决方法的人的答案。
The Method goes like this:
方法是这样的：
Run a looplike this once to change the names of the Rectanglesto the Address of their TopLeftCell
loop像这样运行一次以将名称更改Rectangles为他们的地址TopLeftCell
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
sh.Name = sh.TopLeftCell.Address
Next sh
Now in any other code you can directly access the shape using:
现在在任何其他代码中，您可以使用以下命令直接访问形状：
ActiveSheet.Shapes(ActiveCell.Address).Select
This is one way you can achieve it. Though there doesn't exist a method that you are looking for.
这是您可以实现的一种方式。虽然不存在您正在寻找的方法。
You can change the ActiveCell.Addressany range object or maybe just the text itself. It will take values like $D$4
您可以更改ActiveCell.Address任何范围对象或可能只是文本本身。它将采用类似的值$D$4
Tried and Tested, it works Smoothly.
久经考验，运行流畅。
