要重新创建问题：

Question

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

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

使用＆＃34;（上一页）＆＃34;附加到文件名。
包含新数据的原始文件的新版本 - 这是下个月的模板。
包含新数据的新文件 - 这是通过电子邮件发送的报告版本。

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

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

要重新创建问题：

创建一个新文件夹并在其中放置一个新的空白演示文稿。
从第一张幻灯片中删除Click to add title和click to add subtitle个对象。
在Insert功能区上，从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视图更改为slideorter的示例，对形状执行操作（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进行更新

要重新创建问题：

2 个答案: