excel - 如何使用 VBA 将形状粘贴到 Excel 工作表中的现有形状之后？

Question

我想复制一个形状并将其粘贴到已包含一个或多个形状的工作表中。我尝试使用以下简单代码:

myShape.Select
Selection.Copy
ActiveWorkbook.Sheets(mySheet).Paste

但它会将其粘贴到工作表中现有形状的上方...

是否有解决方案来检测现有形状的末尾或直接粘贴在之后？ 谢谢

Answer 1

这就是你正在尝试的吗？

Sub Sample()
    Dim myShape As Shape

    Set myShape = ActiveSheet.Shapes("Rectangle 1")

    myShape.Copy

    ActiveSheet.Paste

    With Selection
        .Top = myShape.Height + 10
        .Left = myShape.Left
    End With
End Sub

如果有更多形状，那么您将必须循环遍历所有形状，然后找到最后一个形状并考虑该形状的 .Top 和 .Height 。

查看此示例

Option Explicit

Sub Sample()
    Dim myShape As Shape, shp As Shape
    Dim sHeight As Double, sTopp As Double

    For Each shp In ActiveSheet.Shapes
        If shp.Top > sTopp Then
            sTopp = shp.Top
            sHeight = shp.Height
        End If
    Next

    Set myShape = ActiveSheet.Shapes("Rectangle 1")

    myShape.Copy

    ActiveSheet.Paste

    With Selection
        .Top = sTopp + sHeight + 10
        .Left = myShape.Left
    End With
End Sub