Excel VBA：复制和粘贴形状在相同的位置
我想从一个工作表中复制所有形状，并将其粘贴到另一个工作表上的相同位置。 形状可以是矩形标注或图片。
到目前为止，我知道如何遍历旧工作表中的所有形状：
Dim s As Shape For each s in Activesheet.Shapes ... Next
如何在另一个工作表的相同位置复制和粘贴形状，比如表格（“新”）？
下面的代码应该让你去。 请注意，我在代码中使用内部工作表名称。 （ Sheet1和Sheet2 Explorer中括号前的名称）
我使用了一些解决方法来避免使用select：首先需要设置形状的名称，因为如果它仍然具有标准名称（例如“椭圆3”），则名称被更改（“椭圆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. 根据评论的要求
据我所知，没有具体的方法来复制所有这些。 你可以试试.Copy Destination:=...方法，但我不积极，这将工作。
另一种方法是在新工作表上生成具有与所需形状相同属性的新形状。 在循环显示当前工作表中的形状时，只需创build具有所有相同属性的新形状对象即可。
最有效的方法（尽pipe这取决于你的意图）只是复制原始工作表，而不是生成一个新的工作表。 这将把所有的形状（和其他数据）拉到所有的位置和属性保持一致的新工作表。 如果您只需要形状而不是单元格数据，则可以复制工作表，然后添加NewSheet.UsedRange.ClearContents ，这将删除所有数据，但保留格式不变。