Powerpoint 2010 中图表背后的数据未通过 VBA 更新

Question

我在处理包含 Excel 图表的 OLEFormat.Object 的 Powerpoint 2010 演示文稿时遇到问题。

我使用 Excel 中的数据更新图表并在不同阶段保存它 - 我的想法是我最终得到三个演示文稿：

已重命名并在文件名后附加“（上一个）”一词的原件。
包含新数据的原始文件的新版本 - 这是下个月的模板。
包含新数据的新文件 - 这是通过电子邮件发送的报告版本。

我遇到的问题是图表似乎没有保留更新的数据。图表将显示新数据，但一旦我去编辑图表，它就会翻转回来，只显示原始数据——工作表中没有更新的数据。

下图显示了我的意思 - 它们都是同一张图表，但一旦我编辑图表，最后一个系列就会从 12 月变回 6 月。

重现问题：

创建一个新文件夹并在其中放置一个新的空白演示文稿。
从第一张幻灯片中删除 Click to add title 和 click to add subtitle 对象。
在 Insert 功能区上 select Object 和 Insert Excel Chart 来自 Insert Object 对话框。
该图表名为 Object 3（因为您删除了前两个对象）并且包含六个月的随机数据。
确保将演示文稿另存为 Presentation 1.pptx。
在同一文件夹中创建一个新的 Excel 2010 工作簿。

将以下 VBA 代码添加到工作簿中的模块并执行 Produce_Report 过程：

Option Explicit

Public Sub Produce_Report()

    Dim sTemplate As String             'Path to PPTX Template.
    Dim oPPT As Object                  'Reference to PPT application.
    Dim oPresentation As Object         'Reference to opened presentation.

    sTemplate = ThisWorkbook.Path & "\Presentation1.pptx"

    'Open the Powerpoint template and save a copy so we can roll back.
    Set oPPT = CreatePPT
    Set oPresentation = oPPT.Presentations.Open(sTemplate)

    'Save a copy of the template - allows a rollback.
    oPresentation.SaveCopyAs _
        Left(oPresentation.FullName, InStrRev(oPresentation.FullName, ".") - 1) & " (Previous)"

    'Update the chart.
    Audit_Volumes oPresentation.slides(1)

    'Save the presentation using the current name.
    oPresentation.Save

    'Save the presentation giving it a new report name.
    oPresentation.SaveAs ThisWorkbook.Path & "\New Presentation"

End Sub

Private Sub Audit_Volumes(oSlide As Object)
    Dim wrkSht As Worksheet
    Dim wrkCht As Chart
    With oSlide
        With .Shapes("Object 3")
            Set wrkSht = .OLEFormat.Object.Worksheets(1)
            Set wrkCht = .OLEFormat.Object.Charts(1)
        End With
        With wrkSht
            .Range("A3:D7").Copy Destination:=.Range("A2")
            .Range("A7:D7") = Array("December", 3, 4, 5)
        End With

        RefreshThumbnail .Parent

    End With
    Set wrkSht = Nothing
    Set wrkCht = Nothing
End Sub

Public Sub RefreshThumbnail(PPT As Object)
    With PPT
        .designs(1).slidemaster.Shapes(1).Left = .designs(1).slidemaster.Shapes(1).Left + 1
        .designs(1).slidemaster.Shapes(1).Left = .designs(1).slidemaster.Shapes(1).Left - 1
    End With
End Sub

Public Function CreatePPT(Optional bVisible As Boolean = True) As Object
    Dim oTmpPPT As Object
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Defer error trapping in case Powerpoint is not running. '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    Set oTmpPPT = GetObject(, "Powerpoint.Application")
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'If an error occurs then create an instance of Powerpoint. '
    'Reinstate error handling.                                 '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Err.Number <> 0 Then
        Err.Clear
        Set oTmpPPT = CreateObject("Powerpoint.Application")
    End If
    oTmpPPT.Visible = bVisible
    Set CreatePPT = oTmpPPT
    On Error GoTo 0
End Function

更新图表后保存的两个版本的演示文稿是否应该显示更新图表的数据？

Answer 1

在 Powerpoint 中更新图表时，我之前看到过将 Powerpoint 视图更改为幻灯片排序、对形状 (DoVerb) 执行操作然后再次切换视图的示例。
我经常遇到代码抛出错误的问题，可能是因为我通常从 Excel 或 Access.

更新 Powerpoint

我尝试了一下并开始工作。
据我所知，嵌入式图表对象有两个可用动词 - Edit 和 Open.
所以在我有 RefreshThumbnail .Parent 的代码中，我已将代码更新为 RefreshChart .Parent, .slidenumber, .Shapes("Object 3")。

新程序是：

Public Sub RefreshChart(oPPT As Object, SlideNum As Long, sh As Object)
    oPPT.Windows(1).viewtype = 7 'ppViewSlideSorter
    oPPT.Windows(1).View.gotoslide SlideNum
    oPPT.Windows(1).viewtype = 9 'ppViewNormal
    sh.OLEFormat.DoVerb (1)
End Sub

（之前我使用的是 oPPT.ActiveWindow，我认为这是导致问题的原因）。

现在我遇到的问题是一张图表自行调整大小，而另一张图表背后的计算没有重新计算 - 我认为不同的问题对应不同的问题。

Answer 2

您可以尝试用这个替换 RefreshChart 子例程（来自 Darren Bartrup-Cook）

oPPT.OLEFormat.Activate
Call Pause or Sleep (3000) ' anything that pauses the macro and allows Powerpoint to do it's work
ActiveWindow.Selection.Unselect  'This is like clicking off the opened embedded object

你可能也需要这个。其中 slideindex 是当前幻灯片的索引。

 ActiveWindow.View.GotoSlide oSl.Slideindex

Powerpoint 2010 中图表背后的数据未通过 VBA 更新

Data behind chart in Powerpoint 2010 is not updating through VBA

excel

vba

excel-2010

powerpoint-2010

重现问题：