查找PPT中某种字体的全部对应文字

本文章的目的是找到某种字体的文字，而不是替换某种字体的文字，也不是将某种字体全部替换为另外一种文字。

第一步：在PPT中按下ALT+F11

出现以下窗口

第二步：点击插入->模块

第三步：将以下代码输入到窗体中

Sub FindTextByFont()
    Dim slide As slide
    Dim shape As shape
    Dim textRange As textRange
    Dim fontName As String
    Dim foundTexts As String
    Dim found As Boolean

    ' 要查找的字体名称
    fontName = InputBox("请输入要查找的字体名称:", "查找字体")

    If fontName = "" Then Exit Sub

    found = False
    foundTexts = "以下是使用字体 """ & fontName & """ 的文字:" & vbCrLf & vbCrLf

    ' 遍历所有幻灯片
    For Each slide In ActivePresentation.Slides
        ' 遍历每张幻灯片上的所有形状
        For Each shape In slide.Shapes
            ' 检查形状是否有文本
            If shape.HasTextFrame Then
                If shape.TextFrame.HasText Then
                    ' 遍历形状的所有文本范围
                    For Each textRange In shape.TextFrame.textRange.Runs
                        ' 如果文本范围的字体名称匹配
                        If textRange.Font.Name = fontName Then
                            found = True
                            foundTexts = foundTexts & "幻灯片 " & slide.SlideIndex & " 中的文字: " & textRange.Text & vbCrLf
                        End If
                    Next textRange
                End If
            End If
        Next shape
    Next slide

    If found Then
        MsgBox foundTexts
    Else
        MsgBox "没有找到使用字体 """ & fontName & """ 的文字。"
    End If
End Sub

第四步：按下F5 ，运行后会弹出新的窗口
输入字体后，会列出所有的文字位置