将 Excel 范围作为图片粘贴到 PowerPoint

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-方法

将范围复制为图像

使用 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

将 Excel 范围作为图片粘贴到 PowerPoint

Paste Excel range as Picture to Power Point

excel

powerpoint

vba