使用VBA更新PowerPoint图表

时间:2017-07-25 21:41:20

标签: excel vba excel-vba powerpoint powerpoint-vba

我知道这个问题已经被多次询问和回答,但不幸的是找不到合适的解决方案。

所以,我在PowerPoint中有一个非常简单的演示文稿(只有一张幻灯片,其中一张图表是从Excel表格创建的),需要通过VBA更新最新数据,无论是运行Excel还是PowerPoint脚本。

首先,我尝试了PowerPoint中最明显的脚本:

Sub update1()
ActivePresentation.UpdateLinks
End Sub

它似乎运行但没有做任何改变。然后我开始在网上搜索解决方案,并找到例如以下topic on StackOverflow

对于乐观忙碌的答案,它运行没有错误,并在MessageBox中给我一个输出,但它在PowerPoint图表中没有任何改变。

对于rinusp的回答,它给了我一个错误

  

运行时错误' 91':对象变量或未设置块变量

就行了

For each sld in myPresentation.Slides

我在PowerPoint中尝试了所有这些宏。

我也尝试过StackOverflow上其他问题的答案,但不幸的是没有什么对我有用。如果有人帮我找到任何可行的解决方案,我会很高兴 - 如果要运行VBA脚本,请不要使用Excel或PowerPoint。

提前致谢。

更新:我使用我尝试运行的代码的完整示例更新了我的问题。这个例子是由用户Optimistic Busy和rinusp在上面提到的StackOverflow主题上提供的。

从PowerPoint运行时此代码给我一个错误"运行时错误' 91':对象变量或With block变量未设置"

Sub update2()

Dim myPresentation As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim myChart As PowerPoint.Chart

For Each sld In myPresentation.Slides
    For Each shp In sld.Shapes
        If shp.HasChart Then
            Set myChart = shp.Chart
            myChart.ChartData.Activate
            myChart.Refresh
        End If
    Next
Next

End Sub

并且此代码运行没有错误,并在消息框中提供输出,但不更新图表

Sub update3()
Dim sld As Slide, shp As Shape

For Each sld In ActivePresentation.Slides

   For Each shp In sld.Shapes
     On Error Resume Next
     shp.LinkFormat.Update
    Next

Next

MsgBox ("Update chart")

End Sub

1 个答案:

答案 0 :(得分:2)

如果您在powerpoint中运行宏并且图表已链接,则此代码将起作用。

Sub update2()

Dim myPresentation As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim myChart As PowerPoint.Chart
Dim Wb As Object
Dim App As Object

Set myPresentation = ActivePresentation

For Each sld In myPresentation.Slides
    For Each shp In sld.Shapes
        If shp.HasChart Then
            Set myChart = shp.Chart
            myChart.ChartData.Activate
            myChart.Refresh
            Set Wb = myChart.ChartData.Workbook
            Set App = Wb.Application
            Wb.Close (0)
        End If
    Next
Next
App.Quit
End Sub