这个操作如果手工操作的话 ， 估计做到打哈欠都未必所有的PPT都确定已经把对应的文字删除了 。而PPT又没有相应的公式，使用查找功能也只能实现单个PPT的操作 。所以，只能采用PPT VBA 实现 。下面就介绍使用PPT VBA一次性删除掉相同的文字吧 。
【需求】有5000份PPT ， 需要将该文档中的“ABC”文字去掉 。
以下是本人创建的PPT 。
文件路径放在：
【操作方法】
一、在其它路径下新建一份PPT，如在E:，如下图：
二、打开刚才新建的PPT，点击【开发工具】的【查看代码】
三、在弹出的窗口中于左侧鼠标右键点击，选择【插入】子级菜单的【模块】，右侧便创建了一个模块新的编辑区 。
————代码区—————–
Sub changeFileFont()
Dim pres As Presentation
Dim s As Slide
Dim shp As Shape
Dim oTxtRng As TextRange
Dim oTmpRng As TextRange
Dim fs, f, f1, fc
Set fs = CreateObject(“Scripting.FileSystemObject”)
Set f = fs.GetFolder(“E:快速删除PPT的内容”) ‘此处”E:快速删除PPT的内容”为实际中存放PPT的路径,根据实际存放的路径在此处修改即可.
Set fc = f.Files
For Each f1 In fc
If f1 Like “*.pptx” Then
Debug.Print f1
Set pres = Presentations.Open(FileName:=f1)
For Each s In ActivePresentation.Slides
For Each shp In s.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
【如何快速删除ppt中所有相同文字】
Set oTxtRng = shp.TextFrame.TextRange
Set oTmpRng = oTxtRng.Replace(“ABC”, “”, WholeWords:=msoTrue) ‘此处的”ABC”为我们实际中要查找的内容,可根据需要将ABC输成其他文字.
Do While Not oTmpRng Is Nothing
Set oTmpRng = oTxtRng.Replace(“ABC”, “”, WholeWords:=msoTrue) ‘此处的”ABC”为我们实际中要查找的内容,可根据需要将ABC输成其他文字.
Loop
End If
End If
Next
Next
ActiveWindow.ViewType = ppViewSlide
pres.Save
pres.Close
End If
Next
End Sub
————-代码区——————
如下图：
五、点击【运行】
六、最终的效果：
【注】菜单栏没有显示【开发工具】调出方法
于【文件】菜单栏中选择【选项】，在弹出的窗口中如下图所示，将开发工具打勾即可 。
