创建宏将所有字体颜色导出到文本文件/Excel

Question

我想创建一个宏，它基本上可以导出 Powerpoint 演示文稿中使用的所有字体颜色，并列出它们存在于哪些幻灯片上。主要原因是，不知何故，几种不同色调的黑色/绿色进入了演示文稿（我的色盲眼睛很难区分这些色调），我希望看到它在某种列表中被调用。我在网上看不到太多有帮助的东西 - 有什么想法吗？

Answer 1

形状内的文本可以有多种颜色设置。该代码迭代所有字符以收集有关所使用的字体名称和颜色的信息。

Sub ExtractFontsAndColors()
    Dim pptSlide As Object
    Dim pptShape As Object
    Dim textRange As Object
    Dim outputFile As String
    Dim Object As Object
    Dim sKey
    Set objDic = CreateObject("scripting.dictionary")
    outputFile = "d:\temp\color.txt"
    objDic("FontName" & vbTab & "Color") = ""
    For Each pptSlide In ActivePresentation.Slides
        For Each pptShape In pptSlide.Shapes
            If pptShape.HasTextFrame Then
                Set textRange = pptShape.TextFrame.textRange
                For i = 1 To Len(textRange.Text)
                    With textRange.Characters(i, 1).Font
                        sKey = .Name & vbTab & .Color
                        objDic(sKey) = ""
                    End With
                Next i
            End If
        Next pptShape
    Next pptSlide
    Open outputFile For Output As #1
    Print #1, Join(objDic.Keys, vbCrLf)
    Close #1
    MsgBox "Output file: " & outputFile
End Sub

输出：

FontName    Color
Abadi   255
Abadi   0
Amasis MT Pro   14524133