Question

利用vba代码如何选取指定区域内的所有shape对象.

Answer 1

代码及注释如下:
Sub main()
Dim Sh1(1 To 100) As String‘定义数组，用于存放shape名
Dim sh As Shape
Dim i As Integer
With Worksheets("Sheet6")
For Each sh In .Shapes'遍历所有的Shape对象
If Not Application.Intersect(sh.TopLeftCell, .Range("A1:J20")) Is Nothing Then'Shape对象如何不在A1:J20区域中
i = i + 1'累加数量
Sh1(i) = sh.Name'将Shape名依次存放在数组Sh1中
End If
Next sh
End With
ActiveSheet.Shapes.Range(Sh1).Select，选中Sh1中存放的Shape
End Sub

Answer 2

返回A1:D20 内SHAPE名称，名称放在A列；代码如下：

Sub aa()
Dim ms As Shape
For Each ms In Sheets("Sheet6").Shapes
If ms.BottomRightCell.Row <= 20 And ms.BottomRightCell.Column <= 10 Then
k = k + 1
Cells(k, 1) = ms.Name
End If
Next ms
End Sub

追问

返回名称后，能直接将它们都选中么

追答

选中你要进行操作吗？说一下，下一步做什么呢！

追问

集体上移

追答

可以一个个移啥，都移相同的距离，如果一定要全部选中，吃个饭回来写。

追问

行，我看好你

追答

OK了。

Sub Test()
    Dim Sh1(1 To 100) As String
    Dim sh As Shape
    Dim i As Integer
        With Worksheets("Sheet6")
            For Each sh In .Shapes
                If Not Application.Intersect(sh.TopLeftCell, .Range("A1:J20")) Is Nothing Then
                    i = i + 1
                    Sh1(i) = sh.Name
                End If
            Next sh
        End With
        ActiveSheet.Shapes.Range(Sh1).Select
End Sub

 

这个也可以，简单点

Sub Test()
s$ = ""
For Each ms In Sheets("Sheet6").Shapes
   If ms.BottomRightCell.Row <= 20 And ms.BottomRightCell.Column <= 10 Then s = s & "," & ms.Name
MsgBox s
Next ms
s = Mid(s, 2)
ActiveSheet.Shapes.Range(Split(s, ",")).Select
End Sub