如何提取PowerPoint幻灯片母版版式中的形状数据并导出至Excel

核心原理 #

要访问幻灯片母版内的版式形状，按照以下层级调用对象即可，访问逻辑和普通幻灯片的形状完全一致：
演示文稿对象 → Designs集合 → SlideMaster对象 → CustomLayouts集合（即所有版式） → Shapes集合（版式内的所有形状）

代码修改说明 #

• 保留原有普通幻灯片的形状提取逻辑，新增母版版式的形状遍历代码
• 修正原代码内注释笔误（原注释误将Excel写为Outlook）
• 可根据需求筛选特定版式，无需提取所有母版版式内容

完整修改后代码 #

Sub ExportMultiplePowerPointSlidesToExcel()

Dim PPTPres As Presentation
Dim PPTSlide As Slide
Dim PPTShape As Shape
Dim PPTLayout As CustomLayout ' 新增版式对象变量

Dim PPTTable As Table
Dim PPTPlaceHolder As PlaceholderFormat

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlWrkSheet As Excel.Worksheet
Dim xlRange As Excel.Range
    
    ' 获取当前打开的演示文稿
Set PPTPres = Application.ActivePresentation
                         
    ' 出错时继续执行
On Error Resume Next
        
     ' 尝试获取已打开的Excel实例
Set xlApp = GetObject(, "Excel.Application")
        
      ' 如果Excel未打开则新建实例
If Err.Number = 429 Then
            
      ' 清除错误
   Err.Clear
            
' 新建Excel应用
   Set xlApp = New Excel.Application
                
' 设置Excel可见
   xlApp.Visible = True
                
' 新建工作簿
   Set xlBook = xlApp.Workbooks.Add
                
' 新增工作表
   Set xlWrkSheet = xlBook.Worksheets.Add
        
  End If
        
' 绑定指定工作簿
Set xlBook = xlApp.Workbooks("ExportFromPowerPointToExcel.xlsm")
        
' 绑定指定工作表
Set xlWrkSheet = xlBook.Worksheets("Slide_Export")

' --------------------------
' 原有逻辑：提取普通幻灯片内容（原代码仅处理第1张，如需处理所有幻灯片可改为For Each遍历）
' --------------------------
Set PPTSlide = ActivePresentation.Slides(1)
For Each PPTShape In PPTSlide.Shapes
    If PPTShape.Type = msoPlaceholder Or PPTShape.Type = ppPlaceholderVerticalObject Then
        ' 定位到最后一行非空单元格
        Set xlRange = xlWrkSheet.Range("A20").End(xlUp)
        If xlRange.Value <> "" Then
           Set xlRange = xlRange.Offset(1, 0)
        End If
        ' 写入形状文本
        xlRange.Value = PPTShape.TextFrame.TextRange
        ' 可选：B列标注数据来源
        xlRange.Offset(0, 1).Value = "普通幻灯片-" & PPTSlide.SlideIndex
    End If
Next

' --------------------------
' 新增逻辑：提取母版版式内容
' --------------------------
Dim i As Integer
For i = 1 To PPTPres.Designs.Count
    ' 遍历当前设计下的所有自定义版式
    For Each PPTLayout In PPTPres.Designs(i).SlideMaster.CustomLayouts
        ' 【可选筛选】如果只需要特定版式，取消下一行注释并修改版式名称即可
        ' If PPTLayout.Name <> "你需要提取的版式名称" Then GoTo NextLayout
        
        ' 遍历版式内所有形状
        For Each PPTShape In PPTLayout.Shapes
            If PPTShape.Type = msoPlaceholder Or PPTShape.Type = ppPlaceholderVerticalObject Then
                ' 跳过无文本的形状
                If Not PPTShape.TextFrame.HasText Then GoTo NextShape
                
                ' 定位到最后一行非空单元格
                Set xlRange = xlWrkSheet.Range("A20").End(xlUp)
                If xlRange.Value <> "" Then
                   Set xlRange = xlRange.Offset(1, 0)
                End If
                ' 写入形状文本
                xlRange.Value = PPTShape.TextFrame.TextRange
                ' 可选：B列标注数据来源
                xlRange.Offset(0, 1).Value = "母版版式-" & PPTLayout.Name
            End If
NextShape:
        Next
NextLayout:
    Next
Next
        
' 格式化工作表
xlWrkSheet.Columns.ColumnWidth = 20    
xlWrkSheet.Rows.RowHeight = 20
xlWrkSheet.Cells.HorizontalAlignment = xlLeft
xlApp.ActiveWindow.DisplayGridLines = False
        
End Sub

注意事项 #

• 运行代码前请确认Excel中已存在名为ExportFromPowerPointToExcel.xlsm的工作簿，且工作簿内有名为Slide_Export的工作表，否则会出现绑定错误
• 如需提取演示文稿内所有普通幻灯片的内容，可将原有单幻灯片处理逻辑改为For Each PPTSlide In ActivePresentation.Slides遍历所有幻灯片
• 代码中已预留版式筛选的注释，如需提取特定版式内容，取消对应注释并修改版式名称即可

内容的提问来源于stack exchange，提问作者Nicolas D'AOUT