VBA实现从EXCEL单元格更新或修改PPT对应文本框内容并且不改变格式

原创不容易，请不要抄袭！

配置工作

EXCEL 2010版本以上配置

1. 文件-选项-自定义功能区-主选项卡-勾选开发者选项
2. 打开开发者选项里的Visual Basic, 选择工具-引用-勾选Microsoft Powerpoint 14.0 Object Library

开发

1. 打开Visual Basic 在工程框里相应的EXCEL下新建模块，此时会弹出模块1（代码）
2. 编写两个VB函数getshapedata() 和 writedata()

Dim ppapp As PowerPoint.Application
Dim pppres As PowerPoint.Presentation

Sub getshapedata()
'On Error GoTo line1
Set ppapp = GetObject(, "powerpoint.application")
Set pppres = ppapp.ActivePresentation

Dim shapename
Dim shapeslide
Dim shapetext
Dim nextrow

shapeslide = ppapp.ActiveWindow.View.Slide.SlideIndex
shapename = ppapp.ActiveWindow.Selection.ShapeRange(1).Name
shapetext = pppres.Slides(shapeslide).Shapes(shapename).TextEffect.Text
'friendlyname = InputBox("insert one name" & shapetext, "Friendly Name", "")

nextrow = Sheet1.Range("a" & Rows.Count).End(xlUp).Row + 1

Sheet1.Range("a" & nextrow) = shapeslide
Sheet1.Range("b" & nextrow) = shapename
Sheet1.Range("c" & nextrow) = shapetext
'Sheet1.Range("d" & nextrow) = friendlyname

'Exit Sub

'line1:
'MsgBox "no selection"

End Sub


Sub writedata()
Dim c As Object
Dim shapename
Dim slidename
Dim shapetext

Set ppapp = GetObject(, "powerpoint.application")
Set pppres = ppapp.ActivePresentation

For Each c In Sheet1.Range("a2:a" & Sheet1.Range("a" & Rows.Count).End(xlUp).Row)

shapeslide = Sheet1.Range("a" & c.Row)
shapename = Sheet1.Range("b" & c.Row)
shapetext = Sheet1.Range("c" & c.Row)
'friendlyname = Sheet1.Range("d" & c.Row)

pppres.Slides(shapeslide).Shapes(shapename).TextEffect.Text = shapetext

Next c

End Sub

3. 保存

演示

1. 打开保存代码的EXCEL，在开发工具中新建按钮，选择getshapedata,并改按钮名称为get data.
   
2. 按照上一步骤，插入另一个按钮，选择writedata, 并修改名称为write data, 在A1, B1&C1键入shape index(幻灯片索引), shape name（文本框索引）, value（文本框的内容），结果如下图所示。
   
3. 不关闭EXCEL, 并打开PPT，选择想要更新的文本框。
   
4. 按一下EXCEL的按钮get data，ppt对应文本框的三个信息自动生成在excel里，如下所示：
   
5. 保持PPT与EXCEL同时打开，修改目标文本框对应EXCEL里VALUE中的值，例如（今天天气很好），点按钮write data，运行结束后查看下PPT，如下图所示：
   
6. 自动化功能强一点就是这个效果，需要增加格式处理函数text(), round(),left(), 和len()等EXCEL函数。
   6.1 数据源EXCEL加格式处理：
   
   6.2 中间文本框对应EXCEL文件
   
   6.3 可替换PPT里的所有的文本框
   

注意点！！！

PPT里的文本框必须是在创建或设计时新建的文本框，不能是同一个文本框复制的

打赏

本人制作这个代码不容易，希望大家获得便利的同时，支援点粮草，谢谢！

如果有深入问题，请联系modas_lee@foxmail.com