从单元格复制粘贴形状答案

【问题标题】：Copy paste shapes from cells从单元格复制粘贴形状
【发布时间】：2018-02-05 10:26:00
【问题描述】：

我制作了一个代码，可以创建用于打印的标签和条形码。
由于其他原因（为简单起见），我将一些标签放在单独的纸上，然后我需要将它们转移到真实纸上。
我发现有人提到了 CopyObjectsWithCells，但它对我不起作用。

Application.CopyObjectsWithCells = True
Sheets("Robot").Range("A1:L" & Lastrow).Copy
Sheets("Etikett").Range("A" & intRad).PasteSpecial Paste:=xlPasteAll

Range().Select 然后Selection.Copy 得到相同的结果。

Sheets("Robot").Shapes.SelectAll
Selection.Copy

有效。但它使粘贴的图像成为一张大图像，而不是 x 个小图像/形状。并给出一个白色背景覆盖工作表上的其他文本。
如果我在 Excel 中选择范围并按 Ctrl + C / V，它会根据需要复制图像。
但是使用 VBA 就行不通了。

示例图片

【问题讨论】：

您是否尝试过先选择要粘贴的单元格，然后使用ActiveSheet.Paste？您使用的选项PasteSpecial Paste:=xlPasteAll 不会粘贴形状。
@FoxfireAndBurnsAndBurns 没错。谢谢你。请给出答案。
你试过用Record a Macro按钮录制宏吗？做你想做的然后检查代码？
@Vityata 不，我没有。但我的 Foxfires 解决方案奏效了。

标签： excel vba

【解决方案1】：

每当您遇到问题时，可以这样描述：

我已经设法在 Excel 中手动完成，但我找不到正确的 VBA 代码。

一个好的解决方案是使用 VBA 中的宏记录器选项并查看它生成的代码，同时在 Excel 中进行手动工作。在您的情况下，这是它制作的代码，它只是将两个形状复制到另一个工作表：

Sub Makro2()
    ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
    ActiveSheet.Shapes.Range(Array("Rectangle 1", "Rectangle 2")).Select
    Sheets("Tabelle2").Select
    Range("B4").Select
    ActiveSheet.Paste
    Range("M25").Select
End Sub

这段代码真的很糟糕，但它可以工作，它可能会给你很好的洞察力以进一步工作。

【讨论】：

【解决方案2】：

选择并复制包含形状的区域后，选择目标单元格，然后使用ActiveSheet.Paste。

您使用的选项PasteSpecial Paste:=xlPasteAll 不会粘贴形状。

【讨论】：