原创不容易,请不要抄袭!
配置工作
EXCEL 2010版本以上配置
- 文件-选项-自定义功能区-主选项卡-勾选开发者选项
- 打开开发者选项里的Visual Basic, 选择工具-引用-勾选Microsoft Powerpoint 14.0 Object Library
开发
- 打开Visual Basic 在工程框里相应的EXCEL下新建模块,此时会弹出模块1(代码)
- 编写两个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
- 保存
演示
- 打开保存代码的EXCEL,在开发工具中新建按钮,选择getshapedata,并改按钮名称为get data.
- 按照上一步骤,插入另一个按钮,选择writedata, 并修改名称为write data, 在A1, B1&C1键入shape index(幻灯片索引), shape name(文本框索引), value(文本框的内容),结果如下图所示。
- 不关闭EXCEL, 并打开PPT,选择想要更新的文本框。
- 按一下EXCEL的按钮get data,ppt对应文本框的三个信息自动生成在excel里,如下所示:
- 保持PPT与EXCEL同时打开,修改目标文本框对应EXCEL里VALUE中的值,例如(今天天气很好),点按钮write data,运行结束后查看下PPT,如下图所示:
- 自动化功能强一点就是这个效果,需要增加格式处理函数text(), round(),left(), 和len()等EXCEL函数。
6.1 数据源EXCEL加格式处理:
6.2 中间文本框对应EXCEL文件
6.3 可替换PPT里的所有的文本框
注意点!!!
PPT里的文本框必须是在创建或设计时新建的文本框,不能是同一个文本框复制的
打赏
本人制作这个代码不容易,希望大家获得便利的同时,支援点粮草,谢谢!
如果有深入问题,请联系modas_lee@foxmail.com