创建PowerPoint宏：导出所有字体颜色及对应幻灯片位置

核心实现思路 #

1. 遍历演示文稿的每一张幻灯片，逐个检查页面内的所有形状
2. 针对包含文本的形状（包括普通文本框、占位符、分组内的子形状），提取每个文本段落的字体RGB颜色值
3. 用字典存储颜色与对应幻灯片编号的映射，自动去重颜色并合并同一颜色出现的幻灯片
4. 将最终汇总的颜色信息输出到新创建的幻灯片中，直观查看所有颜色及分布位置

完整宏代码 #

Sub ExportFontColorsWithSlides()
    Dim pres As Presentation
    Dim slide As slide
    Dim shp As Shape
    Dim para As Paragraph
    Dim colorDict As Object
    Dim rgbVal As Long
    Dim outputSlide As slide
    Dim outputBox As Shape
    
    ' 初始化字典存储颜色与幻灯片列表映射
    Set colorDict = CreateObject("Scripting.Dictionary")
    Set pres = ActivePresentation
    
    ' 遍历所有幻灯片
    For Each slide In pres.Slides
        ' 遍历当前幻灯片的所有形状
        For Each shp In slide.Shapes
            ' 处理普通文本形状
            If shp.HasTextFrame And shp.TextFrame.HasText Then
                ProcessTextShape shp, slide.SlideIndex, colorDict
            End If
            ' 处理分组形状（递归检查子形状）
            If shp.Type = msoGroup Then
                CheckGroupedShapes shp, slide.SlideIndex, colorDict
            End If
        Next shp
    Next slide
    
    ' 创建汇总结果幻灯片
    Set outputSlide = pres.Slides.Add(pres.Slides.Count + 1, ppLayoutBlank)
    outputSlide.Name = "字体颜色分布汇总"
    
    ' 添加文本框展示结果
    Set outputBox = outputSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                                  50, 50, 600, 500)
    With outputBox.TextFrame.TextRange
        .Text = "演示文稿字体颜色及所在幻灯片汇总:" & vbCrLf & vbCrLf
        .Font.Size = 12
        .Font.Name = "微软雅黑"
    End With
    
    ' 将字典内容写入文本框
    Dim key As Variant
    For Each key In colorDict.Keys
        outputBox.TextFrame.TextRange.Text = outputBox.TextFrame.TextRange.Text & _
                                            "* 颜色: " & key & vbTab & "所在幻灯片: " & colorDict(key) & vbCrLf
    Next key
    
    MsgBox "颜色汇总已生成在最后一张幻灯片!", vbInformation
End Sub

' 处理单个文本形状的字体颜色
Sub ProcessTextShape(shp As Shape, slideIndex As Integer, colorDict As Object)
    Dim para As Paragraph
    Dim rgbVal As Long
    Dim rgbStr As String
    
    For Each para In shp.TextFrame.TextRange.Paragraphs
        rgbVal = para.Font.Color.RGB
        ' 转换RGB值为可读格式
        rgbStr = "RGB(" & _
                  (rgbVal Mod 256) & ", " & _
                  ((rgbVal \ 256) Mod 256) & ", " & _
                  (rgbVal \ 65536) & ")"
        
        ' 更新字典中的幻灯片列表（避免重复）
        If colorDict.Exists(rgbStr) Then
            If InStr(colorDict(rgbStr), "幻灯片 " & slideIndex) = 0 Then
                colorDict(rgbStr) = colorDict(rgbStr) & ", 幻灯片 " & slideIndex
            End If
        Else
            colorDict(rgbStr) = "幻灯片 " & slideIndex
        End If
    Next para
End Sub

' 递归检查分组形状中的子形状
Sub CheckGroupedShapes(shp As Shape, slideIndex As Integer, colorDict As Object)
    Dim subShp As Shape
    For Each subShp In shp.GroupItems
        If subShp.HasTextFrame And subShp.TextFrame.HasText Then
            ProcessTextShape subShp, slideIndex, colorDict
        End If
        ' 递归处理嵌套分组
        If subShp.Type = msoGroup Then
            CheckGroupedShapes subShp, slideIndex, colorDict
        End If
    Next subShp
End Sub

使用说明 #

1. 打开需要处理的PPT文件，按下Alt + F11打开VBA编辑器
2. 插入新模块：右键点击左侧项目窗格中的演示文稿名称 > 插入 > 模块
3. 将上述代码粘贴到模块中，按下F5运行宏，或回到PPT界面通过"开发工具"选项卡执行宏
4. 执行完成后，PPT末尾会新增一张幻灯片，列出所有字体颜色的RGB值及对应的幻灯片编号

注意事项 #

• 需在PPT中启用宏功能：文件 > 选项 > 信任中心 > 信任中心设置 > 宏设置 > 启用所有宏（或根据需求选择合适的宏安全级别）
• 代码会处理所有包含文本的形状，包括分组内的嵌套形状，确保不遗漏任何文本颜色
• RGB值的格式为RGB(红,绿,蓝)，每个分量范围0-255，方便区分不同深浅的黑/绿色

内容的提问来源于stack exchange，提问作者Finpli