将Excel图表粘贴到PowerPoint幻灯片中 [英] Pasting Excel Chart into PowerPoint Slide

问题描述

下面的Sub应该将Excel图表粘贴到新创建的PowerPoint幻灯片中。然后，将图表导出为PNG：

The below Sub is supposed to paste an Excel chart into a newly created PowerPoint slide. It then exports the chart as a PNG:

Sub ChartsToPowerPoint()

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

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

    'Set the charts and copy them to a new ppt slide

    Set objChart = Worksheets("Sheet1").ChartObjects("Chart 1").Chart
    objChart.ChartArea.Copy
    Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
    pptSlide.Shapes.PasteSpecial DataType:=ppPasteDefault, Link:=msoFalse

    'Save Images as png
    path = "C:\Users\xyz\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

我得到了跑步-time错误：

I get a Run-time error:

形状（未知成员）：无效的请求。剪贴板为空或包含的数据可能不会粘贴到此处。

Shapes (unknown member): Invalid request. Clipboard is empty or contains data which may not be pasted here.

在此行：

pptSlide.Shapes.PasteSpecial DataType:=ppPasteDefault, Link:=msoFalse

错误http://im64.gulfup.com/pZNwxJ.png

我尝试了 pptSlide.Shapes.Paste ，但它给出了相同的错误。

I tried pptSlide.Shapes.Paste but it gives the same error.

当我将 pptApp.Presentations.Add（msoFalse）修改为 pptApp.Presentations.Add

When I amend pptApp.Presentations.Add(msoFalse) to pptApp.Presentations.Add only it works but the PowerPoint App is displayed.

当我更改为 .PasteSpecial DataType：= ppPasteEnhancedMetafile 或 .PasteSpecial数据类型：= ppPastePNG 即使使用 .Add（msoFalse）。一切都能顺利进行。

When I change to .PasteSpecial DataType:=ppPasteEnhancedMetafile or .PasteSpecial DataType:=ppPastePNG everything runs smoothly even with .Add(msoFalse).

我认为这可能与确定焦点有关。

I am thinking it might be something to do with setting the focus or so.

推荐答案

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

这篇关于将Excel图表粘贴到PowerPoint幻灯片中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！