将Excel VBA中的图片复制到新工作表

Question

我有以下VBA代码将现有工作表数据复制到新工作表，它可以正常工作，但它无法复制工作表中的图片文件（例如.jpg），我该如何复制图片文件呢？谢谢。

  Set source2 = Worksheets("today").Range("A5:l68")

       Sheets.Add After:=Sheets(Sheets.Count)
    Set dest2 = ActiveWorkbook
    Source2.Copy
      With dest2.Sheets(2)
       .Cells(1).PasteSpecial Paste:=8
       .Cells(1).PasteSpecial Paste:=xlPasteValues
       .Cells(1).PasteSpecial Paste:=xlPasteFormats
       .Cells(1).Select

    Application.CutCopyMode = False

End With

- robin

Answer 1

我认为这个问题是copy & paste a picture from one sheet to another的重复，但无论如何你都可以使用下面的代码...这将在新工作表中以大致相同的位置粘贴图片，与原始工作表。

Sub MG15Jun43
Dim pic As Shape, rng As Range
For Each pic In ActiveSheet.Shapes
   If pic.Type = msoPicture Then
     pic.Copy
     With Sheets("Sheet2")
        .Select
        .Range(pic.TopLeftCell.Address).Select
        .Paste
     End With
     Selection.Placement = xlMoveAndSize
   End If
Next pic
End Sub

- R Hamilton

---

嗨，感谢您的帮助，是的，您的代码有效，但它只复制形状对象，不会复制JPEG文件，有什么办法可以同时复制JPEG文件吗？ - robin

ActiveSheet.Shapes.Range(Array("Picture 2")).Select Selection.Copy Sheets("Sheet3").Select ActiveSheet.Paste - R Hamilton

对我来说可以运行。尝试注释掉你代码中的其余部分，只留下这4行进行测试... - R Hamilton

@R Hamilton提到的那行代码可以提取文件的路径名。尝试调试你的代码，找出Shape是否具有.jpeg文件名。有时图像会附加在没有.jpeg文件位置信息的情况下。 - user8753746

Answer 2

尝试使用：

Sheets("today").Copy After:=Sheets(Sheets.Count)

- user8753746

---

嗨，这段代码复制整个工作表，但我只想复制特定的单元格范围。无论如何，感谢您的帮助。 - robin