有5000多个ppt文件，里面都有一些相同的文字，如何快速删除这些相同的文字？
网友解答: PPT快速删除相同的文字的方法——按下 ctrl + H 快捷键，弹出“替换”窗口在替换窗口的“查找内容”处，输入要删除的内容，如明天，点击“全部替换”点击“确定”关闭“替换
PPT快速删除相同的文字的方法——
按下 ctrl + H 快捷键，弹出“替换”窗口
在替换窗口的“查找内容”处，输入要删除的内容，如明天，点击“全部替换”
点击“确定”
关闭“替换”窗口，所有想要删除的相同的文字已经被删除了
网友解答:这个操作如果手工操作的话，估计做到打哈欠都未必所有的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
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
-------------代码区------------------
如下图：
五、点击【运行】
六、最终的效果：
【注】菜单栏没有显示【开发工具】调出方法
于【文件】菜单栏中选择【选项】，在弹出的窗口中如下图所示，将开发工具打勾即可。
欢迎关注本人酷米号，本人专注Office领域研究。