2

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

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

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

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

4

1 回答 1

6

这是你正在尝试的吗?

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
于 2012-04-20T10:12:35.970 回答