將 Excel 圖表粘貼到 PowerPoint 幻燈片中

Question

下面的 Sub 應該將 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

我收到一個運行時錯誤：

形狀（未知成員）：請求無效。 剪貼板為空或包含可能無法粘貼到此處的數據。

在線：

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

錯誤 http://im64.gulfup.com/pZNwxJ.png

我試過pptSlide.Shapes.Paste但它給出了同樣的錯誤。

當我將pptApp.Presentations.Add(msoFalse)修改為pptApp.Presentations.Add它僅起作用，但顯示 PowerPoint 應用程序。

當我更改為.PasteSpecial DataType:=ppPasteEnhancedMetafile或.PasteSpecial DataType:=ppPastePNG即使使用.Add(msoFalse)也能順利運行。

我認為這可能與設置焦點有關。

Answer 1

PasteSpecial和CommandBars.ExecuteMso應該都可以工作（在 Excel/PowerPoint 2010 中測試了您的代碼，注意事項如下：

添加演示文稿時，必須打開它WithWindow:=True

Set pptPres = pptApp.Presentations.Add(msoCTrue)

我做了更多的挖掘，你需要使用CopyPicture方法，然后我認為你可以打開 withwindow= 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

Answer 2

這是我們將信息從一個 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 應用程序暫停一秒鍾。 這將給它足夠的時間來確保信息存儲在剪貼板中。

您可能會問為什么有時會發生這種情況，但有時不會。 好吧，歸根結底就是剪貼板可能會出現不可預測的行為並清除其中的信息。

這就是為什么我們可以避免將信息存儲在剪貼板中的原因。 然而，在這種情況下，我們無法避免它，所以我們只能忍受不可預測性。

Answer 3

如果 PowerPoint 有 Application.Wait 消息，@areed1192 的答案可能會起作用，但這是 Excel 內容。

通過使用此處找到的技術，我能夠做類似的事情：

也就是說，在模塊的頂部放一個：

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

然后像這樣調用它：

Sleep 1000
DoEvents

（我不認為 DoEvents 有幫助，但如果發生這種情況，在 VBA 中解決競爭條件似乎是個好主意。）

Answer 4

sld.Shapes.PasteSpecial 數據類型：=0

或者

sld.Shapes.PasteSpecial DataType:=ppPasteShape