PPT里每页都有同一个图形/文字?别一页页删了,30秒批量清空

PPT里每页都有同一个图形/文字？别一页页删了，30秒批量清空

前两天同事接到一份75页的汇报材料，每页下边角都压着一个横线。他一页一页点，删到第40分钟才发现中间漏了7页，又倒回去重来。（如下图红框和青色框内容）

这种“每页都有、位置大小完全一样”的图形和文字，其实根本不用手动删。写一段不到20行的小代码，选中其中一个，一键扫完所有页面，30秒结束。

今天把整套方法讲透，代码可以直接复制，操作一共就6步。

一、先别急着删：确认这个图形到底“长”在哪

PPT里的重复图形有两种来源，处理方式完全不同，先花一分钟确认，能省掉后面所有麻烦。（是母版内容？还是非母版内容？）

第1步，进母版视图看一看

点顶部菜单的“视图”，选择“幻灯片母版”。左侧会列出母版和它下面的所有版式。

第2步，检查母版本体和当前使用的版式

先看最顶部那张最大的母版页，再看你这些幻灯片实际用到的版式。如果图形在这里，直接在母版视图里删除，所有幻灯片上的它会一次性全部消失，这是最省事的情况。（在这里如果能删除，最好啦！本次PPT内容不在母版，所以无法采用这个办法来删除咯！）

第3步，确认背景图形有没有被隐藏

回到普通视图，右键空白处选“设置背景格式”，看看“隐藏背景图形”这一项有没有被勾选。如果图形来自母版背景，勾上这一项也能让它整体消失，不需要删。（本次PPT背景为纯色，与横线和文字都没有关系，所以不能按照这个来清除啦！）

如果以上三处都没有，那就可以确定：它是每一页上独立存在的对象，只能逐个删除。继续往下看。

二、最快的方法：一段代码，按位置和大小批量删除

PPT没有提供“跨页批量删除同一形状”的按钮，插件也不好精确定位，最直接的办法是用VBA宏：先选中一个要删的图形，把它当成样本，记下它的坐标和尺寸，然后遍历所有幻灯片，凡位置大小对得上的一律删掉。

操作步骤

第1步，打开PPT文件，按Alt加F11，调出VBA编辑器。

第2步，在编辑器里点“插入”，选择“模块”，会出现一个空白代码窗口。

第3步，把下面这段代码完整粘贴进去。

Sub 删除相同位置相同图形()

Dim sld As Slide

Dimshp As Shape

DimrefLeft As Single, refTop As Single

DimrefWidth As Single, refHeight As Single

Dimtol As Single

Dimi As Long, delCount As Long

' 容差，单位磅。位置有微小偏差时可调大，比如 2 或 5

tol= 2

'先判断有没有选中图形

If ActiveWindow.Selection.Type <> 2 Then

MsgBox"请先在幻灯片上选中一个要删除的图形，再运行本宏。"

ExitSub

EndIf

'以选中的图形作为样本，读取它的位置和大小

With ActiveWindow.Selection.ShapeRange(1)

refLeft= .Left

refTop= .Top

refWidth= .Width

refHeight= .Height

EndWith

'遍历所有幻灯片，从后往前删，避免索引错乱

For Each sld In ActivePresentation.Slides

Fori = sld.Shapes.Count To 1 Step -1

Setshp = sld.Shapes(i)

IfAbs(shp.Left - refLeft) <= tol _

AndAbs(shp.Top - refTop) <= tol _

AndAbs(shp.Width - refWidth) <= tol _

AndAbs(shp.Height - refHeight) <= tol Then

shp.Delete

delCount= delCount + 1

EndIf

Nexti

Nextsld

MsgBox"批量删除完成，共删除 " & delCount & " 个图形。"

End Sub

第4步，回到PPT普通视图，在任意一页上单击选中那个要删的图形。

第5步，再回到VBA编辑器，把光标放在代码里，按F5运行。

第6步，弹窗会告诉你一共删掉了多少个。这时候翻几页抽查一下，确认没有误删。

同样的方式再删除下方的小文字和页码，来吧，展示！

代码里的两个可调参数

一个是tol，也就是容差，单位是磅，默认给的是2。如果各页图形位置有轻微偏移，比如差了三四个像素，把tol改成5就能全部覆盖；如果页面上有其他同尺寸的图形担心误伤，就把tol改小到0.5。

另一个是匹配条件。现在这段代码要求“位置加大小”四项全部吻合才会删。如果你只关心位置、不管尺寸，可以把后面两行关于宽高的判断删掉。

三、如果每页图形的名字都一样，按名称删更省事

PPT会给每个对象自动编号命名，比如Rectangle 1、Picture 3。如果这些图形是复制粘贴出来的，名字往往完全一致。这种情况不用比对坐标，直接按名字删，速度更快也更准。

查看名字的方法：在“开始”选项卡里点最右侧的“选择”，打开“选择窗格”，窗格里列出的就是当前页所有对象的名称。把名字记下来，替换下面代码里的名称即可。

Sub 按名称删除图形()

Dim sld As Slide

Dimshp As Shapet

Dimi As Long

DimtargetName As String

DimdelCount As Long

targetName= "Rectangle 1"' 改成你实际的图形名称

ForEach sld In ActivePresentation.Slides

Fori = sld.Shapes.Count To 1 Step -1

Setshp = sld.Shapes(i)

Ifshp.Name = targetName Then

shp.Delete

delCount= delCount + 1

EndIf

Nexti

Nextsld

MsgBox"批量删除完成，共删除 " & delCount & " 个图形。"

End Sub

嘿嘿嘿，标题全部都没有了！

四、删之前必须知道的五件事

第一，先另存一份备份

☆☆☆宏删除不可撤销，Ctrl加Z撤不回来。运行之前先“文件另存为”复制一份，出问题直接回退。

☆☆☆宏删除不可撤销，Ctrl加Z撤不回来。运行之前先“文件另存为”复制一份，出问题直接回退。

☆☆☆宏删除不可撤销，Ctrl加Z撤不回来。运行之前先“文件另存为”复制一份，出问题直接回退。

第二，组合图形要特殊处理

如果目标图形是某个组合的一部分，这段代码比对的是整个组合的坐标和大小，匹配不上就不会删。这种情况要先把组合取消，或者改用递归遍历组内形状的代码。

第三，母版上的东西这段代码删不到

ActivePresentation.Slides只会遍历幻灯片页，母版和版式不在范围内。如果扫完一个都没删掉，八成是它在母版里，回到第一部分的方法处理。

第四，占位符同样适用

文本框、图片占位符这类对象，也属于Shapes集合，上面的代码对它们一样有效。

第五，文件要存成启用宏的格式

默认的pptx格式会自动丢弃宏代码。如果想把这段代码留在文件里下次继续用，要另存为pptm格式；如果只是用完即弃，删完直接存pptx就行。另外如果宏被禁用，去“文件、选项、信任中心、宏设置”里临时启用。

五、一句话总结整个流程

先去母版视图排查看看图形是不是继承来的；确认是每页独立对象之后，按Alt加F11新建模块，粘贴代码；回到PPT选中一个样本图形，按F5运行；最后抽查几页并保存备份。

顺手把这个宏存进你的个人宏工作簿，以后遇到同类问题不用再找代码，一键就能跑。

写在最后

办公软件里这类“重复几百次的机械操作”，几乎都有对应的批量解法，难的是你不知道它存在。你上一次被PPT里的什么东西反复折磨过？是删不完的水印、对不齐的文本框，还是改不完的字体？在评论区说说，我挑几个高频问题接着写。

觉得有用的话，点个赞和在看，顺手转给那个还在手动删图形的同事。