Excel VBA：在同一位置复制并粘贴形状

Question

我想复制一个工作表中的所有形状并将它们粘贴到另一工作表的同一位置。形状可以是矩形标注或图片。

到目前为止，我知道如何循环遍历旧工作表中的所有形状：

Dim s As Shape For each s in Activesheet.Shapes ... Next

如何将形状复制并粘贴到另一个工作表（例如 Sheets（“new”））中的同一位置？

Answer 1

下面的代码应该可以帮助您继续。请注意，我在代码中使用内部工作表名称。（Sheet1和Sheet2。项目资源管理器中括号前的名称）

我使用了一些解决方法来避免使用选择：您需要首先设置形状的名称，因为如果它仍然具有标准名称（例如“Oval 3”），则名称会更改（“Oval 4”）。最后，您可以恢复两张图纸中形状的原始名称。

Sub CopyShapes()

    Dim s As Shape
    Dim OriginalName As String

    For Each s In Sheet1.Shapes
        OriginalName = s.Name
        s.Name = "FixedName"
        s.Copy
        Sheet2.Paste
        Sheet2.Shapes("FixedName").Top = s.Top
        Sheet2.Shapes("FixedName").Left = s.Left
        s.Name = OriginalName
        Sheet2.Shapes("FixedName").Name = OriginalName
    Next s

End Sub

编辑：Selection.调整代码以避免按照注释中的要求使用