PPT内置宏教程——放映时用控件切换动态图表

版权声明：本文为博主原创文章，转载请在显著位置标明本文出处以及作者网名，未经作者允许不得用于商业目的。
由于PPT中有多张类似但不太重要的图表，实际汇报时只挑重点说明，其他的基本略过。因此有必要用可选的方式将这些图表折叠到一张PPT中，为PPT瘦身。
参考资料：

A. 首先要解决内嵌图表的控制问题，无极玄易生在文档“演示PPT中动态控制内嵌图表显示”中已列出可用的代码。
B. 其次是图表本身动态更新的问题，实现方法有很多，不熟悉的朋友可以参考小猪也无奈分享的经验【Excel】INDEX函数制作动态图表，里面已经解说得很清楚了。
C. 再是放映时进入事件的触发问题，大梦空间的博文PowerPoint在播放时自动运行宏中有一些示例。

废话不多说，功能实现步骤如下：

内嵌图表类型问题。本文使用的是“插入”→“对象”→“Microsoft Excel Chart”
内嵌图表更新问题。按参考资料B做个全套（Excel数据源、控件数据源、图表数据源、目标单元格）也没关系，仅仅是Excel内置的窗体控件无法在PPT放映时使用罢了。这里需要提示的是，内嵌图表的数据源可以用“粘贴链接”的方式从独立的Excel报表中获取，从而实现动态更新数据源。
内嵌图表格式问题。每个人都要自己的审美，格式方面自己把握，顺便检查一下动态更新时格式是否正常
VBA代码优化记录（无极玄易生的代码可用，但体验不太友好）：
4.1 消除控件操作延迟：原文在获得焦点时更新控件清单，导致选中控件后控件变形，并且必须等待几秒才能正常使用，改为OnSlideShowPageChange事件后不再延迟。
4.2 减少冗余代码：使用slide2.Shapes(2).OLEFormat.Object的绝对引用方式可避免选错对象，.Clear 可一步清空原备选清单，SourceRng.Offset(0, I - 1).Range(“A1”)偏移方式改为Sh.Range(“N” & I + 2)直引等。
4.3 自定义调整：SourceRng、TarCell等参数可根据实际表格进行更新，If .ListIndex = -1 Then .ListIndex = 0 用于解决缺省参数显示出错的问题，前次选中的页面保存后即为默认显示项，不必每次重新定位为第一页
优化后代码如下：

Option Explicit
Dim Wb As Object, Sh As Object, SourceRng As Object, TarCell As Object    '有别于Excel对象，均为Object类型
Sub OnSlideShowPageChange()                             '首次放映时加载“备选项”清单到控件中
If ActivePresentation.SlideShowWindow.View.CurrentShowPosition = 1 ThenDim I As Integer, N As Integer, M As VariantSet Wb = slide2.Shapes(2).OLEFormat.Object          '设置Wb为内嵌的Excel工作簿Set Sh = Wb.worksheets("Sheet1")                    'Sh为指定工作簿Set SourceRng = Sh.Range("N3:N9")                   'SourceRng为备选项对应的单元格区域Set TarCell = Sh.Range("A17")                       'TarCel为目标项对应的单元格With slide2.ComboBox1M = .Value.Clear                                          '更新列表项，实际仅作用于更新后激活功能For I = 1 To SourceRng.Count.AddItem Sh.Range("N" & I + 2)If Sh.Range("N" & I + 2) = M Then N = I - 1Next IIf N = -1 Then.ListIndex = 0                              '缺省默认项则显示第一项Else.ListIndex = N                              '优先按默认项显示End IfTarCell = .Value                                '按目标项修改TarCell单元格的值End With
End If
End Sub
Private Sub Combobox1_change()
TarCell = ComboBox1.Value                               '改变内嵌工作簿中相应单元格的值
End Sub
Private Sub Combobox1_Gotfocus()                        '当控件获得焦点时赋值对象
Dim I As Integer
On Error Resume Next
Set Wb = slide2.Shapes(2).OLEFormat.Object
Set Sh = Wb.worksheets("Sheet1")
Set TarCell = Sh.Range("A17")
End Sub
Private Sub combobox1_lostfocus()                       '当控件失去焦点时释放对象
Set TarCell = Nothing
Set SourceRng = Nothing
Set Sh = Nothing
Set Wb = Nothing
End Sub