Excel VBA：轻松更新PPT中表格数据的方法

此方案针对PPT中已存在一个表格，与EXCEL中表格样式相同。

首先是声明代码：

   Dim pptfile As String   Dim shpTable As Object   Set pptApp = CreateObject("Powerpoint.application")

我这里用的是后期绑定方式，网上许多资料用的是前期绑定方式，例如：

Dim shpTable As PowerPoint.Shape

前期绑定方式需要在：在VBE菜单中“工具——引用”，在“引用”对话框中，勾选“Microsoft PowerPoint 16.0 Object Library”前的复选框，否则会报错：用户定义类型未定义。

接下来的代码：

 pptApp.Visible = True pptfile = "E:\******.pptx"       '指定PPT文档，要全路径 Set pptpres = pptApp.Presentations.Open(pptfile)    '打开指定的PPT文档 pptpres.Slides(3).Select   '选择指定的幻灯片，此步非必须Set shpTable = pptpres.Slides(3).Shapes(“表格 5”)

如何知道需要更新的表格叫什么名字？如下图：在“开始”菜单下有一个“选择”，点选“选择窗格”，选中需要更新的幻灯片，选中表格，右侧就会显示名称。

Set Rng = ActiveSheet.Range("B4:D36")   'EXCEL中表格定义为一个单元格区域For m = 1 To Rng.Rows.Count      For n = 1 To Rng.Columns.Count            shpTable.Table.Cell(m, n).Shape.TextFrame.TextRange.Text = Rng.Cells(m, n).Text      NextNext

EXCEL中定义的区域（行、列）不可比PPT中的表格的行、列多；多会报错。少没问题。

上述代码对于合并单元格，你会发现PPT中的合并单元格都是空格子。需增加如下代码，合并单元格才能被正常更新。

For m = 1 To rng.Rows.Count              For n = 1 To rng.Columns.Count                        If (rng.Cells(m, n).MergeArea.Cells.Count > 1) And (rng.Cells(m, n).Text <> "") Then                               shpTable.Table.Cell(m, n).Merge shpTable.Table.Cell(m + rng.Cells(m, n).MergeArea.Rows.Count - 1,  _                 n + rng.Cells(m, n).MergeArea.Columns.Count - 1)                           End If                Next        Next    

如果合并单元格比较少，可以直接用赋值语句（假如cells(1,2)是合并单元格的第1格）

shpTable.Table.Cell(1, 2).Shape.TextFrame.TextRange.Text = Rng.Cells(1, 2).Text

PPT的保存与关闭：

pptpres.Save pptpres.closepptApp.quit     '退出PowerPoint

附注：EXCEL打开的PPT，不适用ActivePresentation指代当前的PPT。PowerPoint中开的VBA才可用ActivePresentation。

附带PPT的复制、粘贴语句

pptpres.Slides(5).Copy    '复制幻灯片5号pptpres.Slides.Paste        '会自动粘贴到幻灯片尾，不能指定复制到几号pptpres.Slides(10).MoveTo toPos:=4   '将10号移动到第4号，假定最后一张为10号pptpres.Slides(5).Delete    '删除第5号 幻灯片