本文章的目的是找到某种字体的文字,而不是替换某种字体的文字,也不是将某种字体全部替换为另外一种文字。
第一步
:在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,运行后会弹出新的窗口
输入字体后,会列出所有的文字位置