PPT 批量删除每页相同位置的内容

方法：

选择【视图】，【宏】，设置宏的名称，点创建
将下列函数复制到宏中，在ppt中先选择某个要删除的对象，然后运行宏即可

函数内容如下

Sub Delete( )

Dim oSlide As Slide, oShape As Shape

Dim myWidth As Single, myHeight As Single, myTop As Single, myLeft As Single

On Error Resume Next

If ActiveWindow.Selection.ShapeRange.Count <> 1 Then

If Err.Number <> 0 Then

MsgBox "none" & vbCrLf & "choose one", vbExclamation + vbOKOnly

Err.Clear

Exit Sub

End If

MsgBox "choose exceed 1" & vbCrLf & "choose one", vbExclamation + vbOKOnly

Exit Sub

End If

Set oShape = ActiveWindow.Selection.ShapeRange(1)

myTop = oShape.Top

myLeft = oShape.Left

myHeight = oShape.Height

myWidth = oShape.Width

For Each oSlide In ActivePresentation.Slides

For Each oShape In oSlide.Shapes

If Abs(myTop - oShape.Top) < 1 And Abs(myLeft - oShape.Left) < 1 And Abs(myHeight - oShape.Height) < 1 And Abs(myWidth - oShape.Width) < 1 Then

oShape.Delete

End If

Next

Next

End Sub