版权声明：本文为博主原创文章，转载请在显著位置标明本文出处以及作者网名，未经作者允许不得用于商业目的。
由于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 Then
Dim I As Integer, N As Integer, M As Variant
Set 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.ComboBox1
M = .Value
.Clear '更新列表项，实际仅作用于更新后激活功能
For I = 1 To SourceRng.Count
.AddItem Sh.Range("N" & I + 2)
If Sh.Range("N" & I + 2) = M Then N = I - 1
Next I
If N = -1 Then
.ListIndex = 0 '缺省默认项则显示第一项
Else
.ListIndex = N '优先按默认项显示
End If
TarCell = .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
- 成品显示效果：
懒人专用链接：：优先按默认项显示的功能未更新
