复制/粘贴带有形状的单元格

Question

如何将形状与其所在的单元格一起复制？当我手动复制时，形状跟在单元格之后，但是当我使用宏时，我得到了除了形状之外的所有其他内容。

Cells(sourceRow, sourceColumn).Copy
Cells(targetRow, targedColumn).PasteSpecial

...

Range("A1").copy
Range("B2").PasteSpecial Operation:=xlPasteAll

我已经尝试了所有我能想到的......但是形状只是不会移动。

记录手动复制/粘贴，这就是我得到的：

Range("A1").Select
Selection.Copy
Range("A3").Select
ActiveSheet.Paste

Answer 1

我会做这样的事情以避免实际选择单元格：

Sub MoveShape()

  Dim s As Shape
  Dim T, L, celWidth, shpWidth, celHeight, shpHeight As Double
  Dim rng As Range
  Dim ws as Worksheet

  Set s = ws.Shapes(1).Duplicate ''You'll have to get the index of the shape you want to copy 
  Set rng = Range("A3") ''Set this to your target range

  T = rng.Top
  L = rng.Left

  celWidth = rng.Width
  shpWidth = s.Width

  celHeight = rng.Height
  shpHeight = s.Height

  s.Top = T + (celHeight - shpHeight) / 2
  s.Left = L + (celWidth - shpWidth) / 2

End Sub

这将复制您的形状，并将生成的克隆放在目标范围的中心。您可以通过修改s.Left和s.Top值来更改其在单元格中的位置。

现在，您可以使用Range("A3").Value = Range("A1").Value将单元格的实际值复制到目标范围

Answer 2

试试这个

{{1}}