将 Excel 范围作为图片粘贴到 Power Point

Question

我有以下两个代码，我正在尝试当我从 Excel 运行代码时，提到的范围应该作为图片粘贴到 PowerPoint。

但我真的不知道该怎么做。 我用谷歌搜索并搜索了很多，但没有发现您的帮助将不胜感激。

Sub convertaspicture()

Application.CutCopyMode = True

Worksheets("Pivot").Range("FC3:FP35").Copy

.Pictures.Paste
End With

Application.CutCopyMode = False


End Sub


Sub CopyToPowerPoint()
 Dim PPT As Object
    Set PPT = CreateObject("Powerpoint.Application")
    PPT.Visible = True
    PPT.Presentations.Open Filename:="C:\Topline\Topline Writeup.pptx"
    Set PPT = Nothing
End Sub

收到错误：

Answer 1

使用CopyRange -Method将范围复制为图像

使用PasteSpecial将图像粘贴到 Powerpoint 演示文稿中。 以下代码为您提供了思路，它将图像放在第一张幻灯片上并稍微移动它。

Sub testSub()
    Const ppFileName = "C:\Topline\Topline Writeup.pptx"

    Dim PPT As Object
    Set PPT = CreateObject("Powerpoint.Application")
    PPT.Visible = True
    ' Use this if file already exists:
    ' PPT.Presentations.Open Filename:=ppFileName
    ' Use this if you want to create a new file:
    PPT.Presentations.Add
    PPT.ActivePresentation.slides.Add Index:=1, Layout:=12 

    Worksheets("Pivot").Range("FC3:FP35").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    With PPT.ActivePresentation.Slides(1)
        .Shapes.PasteSpecial
        With .Shapes(.Shapes.Count)
            .Left = 200
            .Top = 100
            .Width = 500
        End With
    End With
    ' Use this if you want to save an already existing file:
    ' PPT.ActivePresentation.Save
    ' Use this if you want to create a new file:
    PPT.ActivePresentation.SaveAs ppFileName  
    PPT.Quit
    Set PPT = Nothing

End Sub

更新：如果你想创建一个新的 PPT 文件，使用命令Add （而不是Open ）和SaveAs来保存文件

PPT.Presentations.Add ' <-- No filename here!
..
PPT.ActivePresentation.SaveAs  ppFileName