VBA根据Excel内容快速创建PPT

示例需求:根据Excel中选中的单元格内容(3列)如下图所示,在已打卡的PowerPoint文件中创建页面。

新增PPT Slide页面使用第二个模板页面,其中包含两个文本占位符,和一个图片占位符。将Excel选中区域中前两列写入文字占位符,第3列图片粘贴至图片占位符。

示例代码如下。

vb 复制代码
Sub Excel2PPT()
    Dim xlDataRow As Range
    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim pptSld As PowerPoint.Slide
    Dim objDic As Object
    Dim xlShp As Shape, i As Integer
    Dim sCellAddress As String
    Set pptApp = GetObject(, "PowerPoint.Application")
    Set pptPres = pptApp.ActivePresentation
    If TypeName(Selection) = "Range" Then
        Set objDic = CreateObject("scripting.dictionary")
        For i = 1 To ActiveSheet.Shapes.Count
            Set xlShp = ActiveSheet.Shapes(i)
            If Not Application.Intersect(xlShp.TopLeftCell, Selection) Is Nothing Then
                Set objDic(xlShp.TopLeftCell.Address) = xlShp
            End If
        Next
        For Each xlDataRow In Selection.Rows
            Set pptSld = pptPres.Slides.AddSlide(pptPres.Slides.Count + 1, pptPres.SlideMaster.CustomLayouts(2))
            pptSld.Select
            With pptSld.Shapes
                .Placeholders(1).TextFrame.TextRange.Text = xlDataRow.Cells(1, 1)
                .Placeholders(2).TextFrame.TextRange.Text = xlDataRow.Cells(1, 2)
                sCellAddress = xlDataRow.Cells(1, 3).Address
                If objDic.exists(sCellAddress) Then
                    objDic(sCellAddress).Copy
                    .Placeholders(3).Select
                    .PasteSpecial DataType:=ppPasteMetafilePicture
                End If
            End With
        Next xlDataRow
    End If
End Sub

【代码解析】

第9行代码获取PowerPoint应用程序。

第10行代码获取PowerPoint应用程序中活动Presentation对象。

第11行代码判断Excel中Selection是否为Range对象,如果选中了其他对象(例如Shape对象),后续代码会产生运行时错误。

第12行代码创建字典对象。

第13~18行代码循环遍历活动工作表中的Shape对象,将选中区域中的Shape对象保存在字典对象中。

第14行代码获取Shape对象。

第15行代码判断Shape对象的锚点单元格(即左上角单元格)是否在选中区域中。

如果满足条件,第16行代码将Shape对象保存在字典对象中,其中锚点单元格的引用地址作为字典的键(Key)。

第19~32行代码循环遍历选中区域的数据行。

第20行代码根据第2个模板页面创建一个新的Slide页面。

第21行代码选中新增的页面。

第23行代码将选中区域中第一列内容写入第一个占位符(Placeholder)中。

第24行代码将选中区域中第2列内容写入第2个占位符(Placeholder)中。

第25行代码获取第3列的单元格引用地址。

第26行代码判断第3列的单元格引用地址是否存在于字典的键中,如果不存在,说明该单元格中没有Shape对象。

如果存在,第24行代码拷贝该单元格中的Shape对象。

第28行代码选中图片占位符。

第29行代码粘贴图片。

运行代码效果如下图所示。

微软在线文档:

Shapes.PasteSpecial method (PowerPoint)

相关推荐
qq_5469372718 小时前
excel乱码修复
excel
小兔崽子去哪了21 小时前
EasyExcel 使用
java·excel
学Java的bb1 天前
苍穹外卖-工作台实现、Apache POI、导出Excel报表
excel
Roye_ack2 天前
【项目实战 Day12】springboot + vue 苍穹外卖系统(Apache POI + 工作台模块 + Excel表格导出 完结)
java·spring boot·后端·excel·苍穹外卖
IccBoY2 天前
Java采用easyexcel组件进行excel表格单元格的自动合并
java·开发语言·excel
风车带走过往2 天前
Excel 常用功能自救手册:遇到问题快速排查指南 (个人备忘版)
excel
跟着珅聪学java2 天前
EasyExcel 读取 Excel 文件指南
excel
芭拉拉小魔仙3 天前
Vue项目中如何实现表格选中数据的 Excel 导出
前端·vue.js·excel
RE-19013 天前
Excel基础知识 - 导图笔记
数据分析·学习笔记·excel·思维导图·基础知识·函数应用
ST萌主3 天前
【PPT】导出高清晰度图片(dpi支持自定义)-超简单图文实操-修改注册表
powerpoint