logo标签列表

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

excelvbapowerpoint
3
下面的子程序旨在将Excel图表粘贴到新创建的PowerPoint幻灯片中。然后将图表导出为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

我收到一个运行时错误：

Shapes（未知成员）：无效请求。剪贴板为空或包含不可粘贴的数据。

在这一行：

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

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

我尝试使用pptSlide.Shapes.Paste，但是出现了相同的错误。

当我将pptApp.Presentations.Add(msoFalse)改成pptApp.Presentations.Add时，它可以工作，但PowerPoint App会显示出来。

当我更改为.PasteSpecial DataType:=ppPasteEnhancedMetafile或.PasteSpecial DataType:=ppPastePNG时，一切都能正常运行，即使有.Add(msoFalse)也可以。

我想这可能与设置焦点有关。

@DavidZemens 不，.Chart.Export FileName:="C:\Users\xyz\Desktop\1.png, FilterName:="PNG" 完全可以正常工作。但是在 Excel 2007 SP3 中，使用此方法生成的图表图像质量非常差。由于某种原因，将其粘贴并从 PowerPoint 中保存会更好，这就是我上述方法的原因。 - CaptainABC
尝试使用 pptApp.CommandBars.ExecuteMso "PastePng" 方法代替 PasteSpecial。 - David Zemens
@DavidZemens 使用 pptApp.CommandBars.ExecuteMso "PastePng" 会出现 对象 '_CommandBars' 的方法 'ExecuteMso' 失败 的错误。另外，是否有一种有效的方法可以直接粘贴图表本身，而不是粘贴为 PNG 格式？ - CaptainABC
请参考此链接，直接将图表粘贴到PowerPoint中。 - David Zemens
@DavidZemens 感谢提供链接；但是尝试使用 pptApp.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting" 失败，提示 Method 'ExecuteMso' of object '_CommandBars' failed。这里是我的示例表格链接：https://db.tt/nGrgF5bA - CaptainABC
4个回答
2

PasteSpecial和CommandBars.ExecuteMso都可以使用（在Excel/PowerPoint 2010中测试过您的代码，但有以下注意事项：

当您添加演示文稿时，您必须使用 WithWindow:=True 打开它。

Set pptPres = pptApp.Presentations.Add(msoCTrue)

我进行了更深入的调查，你需要使用 CopyPicture 方法，然后我认为你可以使用 window=False 打开。尝试一下：

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
看起来相当不错，但是它只复制了图表的图像而不是实际的图表本身 :( - CaptainABC
你无论如何都要将它导出为图像，并删除临时的PPT文件。这样做会导致PNG质量明显降低吗？ - David Zemens
让我试一下，明天我会回来（因为我想在办公室测试它）。我将运行两个代码，并查看相同图表之间的质量差异。我会及时通知您 :) - CaptainABC
是的，它看起来相当糟糕...我认为这可能是“hack”是唯一的解决方案的地方... - David Zemens
1

@areed1192的答案可能对Excel有效，但PowerPoint里没有Application.Wait消息。

我通过在这里找到的技巧做到了类似的事情:

也就是说，在模块的顶部放置：

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

然后像这样调用它：

Sleep 1000
DoEvents

（我不确定DoEvents是否有帮助，但如果VBA中存在竞争条件，似乎这可能是解决问题的好方法。）
1
这是我们在将信息从一个Office应用程序复制到另一个应用程序时经常遇到的错误。我能描述它的最好方式是，程序运行得太快，我们复制的信息实际上从未进入剪贴板。

这意味着当我们尝试粘贴时，会出现错误，因为我们的剪贴板中没有要粘贴的内容。

现在幸运的是，有一种方法可以修复此错误，但需要我们添加一行额外的代码。

'Copy the chart
Set objChart = Worksheets("Sheet1").ChartObjects("Chart 1").Chart
    objChart.CopyPicture

'Pause the application for ONE SECOND
Application.Wait Now + #12:00:01 AM#

'Paste your content into a slide as the "Default Data Type"
Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
    pptSlide.Shapes.PasteSpecial DataType:=ppPasteDefault, Link:=msoFalse

现在我所做的就是添加一行额外的代码，让你的Excel应用程序暂停一秒钟。这将给它足够的时间来确保信息被存储在剪贴板中。
你可能会问为什么有时会发生这种情况，而有时不会。 嗯，这只是因为剪贴板可能会表现得不可预测，并清除其中的信息。 这就是为什么如果我们可以避免将信息存储在剪贴板中，我们会尝试避免。但是，在这种情况下，我们无法避免它，所以我们只能接受它的不可预测性。
0

sld.Shapes.PasteSpecial DataType:=0

或者

sld.Shapes.PasteSpecial DataType:=ppPasteShape

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接