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)