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

Question

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

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

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

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

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

重现问题：

• 创建一个新文件夹并在其中放置一个新的空白演示文稿。
• 从第一张幻灯片中删除 Click to add title 和 click to add subtitle 对象。
• 在Insert 功能区上，从Insert Object 对话框中选择Object 和Insert Excel Chart。
  该图表名为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