Sub removeALL() Dim I As Integer: Dim J As Integer Dim oActivePres As Object Set oActivePres = ActivePresentation With oActivePres For I = 1 To .Slides.Count If Val(Application.Version) < 10 Then For J = 1 To .Slides(I).Shapes.Count .Slides(I).Shapes(J).AnimationSettings.Animate = msoFalse Next J Else For J = .Slides(I).TimeLine.MainSequence.Count To 1 Step -1 .Slides(I).TimeLine.MainSequence(J).Delete Next J End If Next I End With Set oActivePres = Nothing End Sub