且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

将Excel图表粘贴到PowerPoint幻灯片中

更新时间:2021-08-04 23:09:08

PasteSpecial CommandBars.ExecuteMso 应该都可以工作(在Excel / PowerPoint 2010中对代码进行了以下警告:

PasteSpecial and CommandBars.ExecuteMso should both work (tested your code in Excel/PowerPoint 2010 with the following caveat:

添加演示文稿时,您必须打开它 WithWindow:= True

When you add presentation, you have to open it WithWindow:=True

Set pptPres = pptApp.Presentations.Add(msoCTrue)

我做了更多的挖掘工作,您需要使用 CopyPicture 方法,然后我可以打开withwindow = False 。尝试:

I did some more digging, you need to use the CopyPicture method and then I think you can open withwindow=False. Try:

Sub ChartsToPowerPoint()

    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim pptSlide As PowerPoint.Slide
    Dim objChart As Chart

    'Open PowerPoint and create an invisible new presentation.
    Set pptApp = New PowerPoint.Application
    Set pptPres = pptApp.Presentations.Add(msoFalse)

    Set objChart = Worksheets("Sheet1").ChartObjects("Chart 1").Chart
    objChart.CopyPicture

    Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
    pptSlide.Shapes.PasteSpecial DataType:=ppPasteDefault, Link:=msoFalse

    'Save Images as png
    Path = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\"

    For j = 1 To pptSlide.Shapes.Count
        With pptSlide.Shapes(j)
        .Export Path & j & ".png", ppShapeFormatPNG
        End With
    Next j

    pptApp.Quit

    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing

End Sub