Remove Advance Slide on 300+ powerpoint files

[abenitez77]

I have about 300 powerpoint files that have advance slide timer on them and I want to remove them so that it does not advance when I open them. How can I do this with vba, so i don't have to open each one individually to do this?

[John Wilson]

IF you mean slides are set to advance on time not on click

Put a COPY of some of the files in a folder called PPTFILES on your desktop and try this code.


Sub Not_Auto()
Dim opres As Presentation
Dim strFile As String
Dim strFolder As String
Dim strSpec As String
Dim osld As Slide
strSpec = "*.pp*"
strFolder = Environ("USERPROFILE") & "/Desktop/PPTFILES/"
strFile = Dir$(strFolder & strSpec)
While strFile <> ""
Set opres = Presentations.Open(strFolder & strFile)
Set osld = opres.Slides(1)
osld.Select
If Not CommandBars.GetPressedMso("SlideTransitionOnMouseClick") Then _
CommandBars.ExecuteMso ("SlideTransitionOnMouseClick")
DoEvents
If CommandBars.GetPressedMso("SlideTransitionAutomaticallyAfter") Then _
CommandBars.ExecuteMso ("SlideTransitionAutomaticallyAfter")
DoEvents
CommandBars.ExecuteMso ("SlideTransitionApplyToAll")
DoEvents
opres.Save
opres.Close
strFile = Dir()
Wend
End Sub

[abenitez77]

IF you mean slides are set to advance on time not on click

Put a COPY of some of the files in a folder called PPTFILES on your desktop and try this code.


Sub Not_Auto()
Dim opres As Presentation
Dim strFile As String
Dim strFolder As String
Dim strSpec As String
Dim osld As Slide
strSpec = "*.pp*"
strFolder = Environ("USERPROFILE") & "/Desktop/PPTFILES/"
strFile = Dir$(strFolder & strSpec)
While strFile <> ""
Set opres = Presentations.Open(strFolder & strFile)
Set osld = opres.Slides(1)
osld.Select
If Not CommandBars.GetPressedMso("SlideTransitionOnMouseClick") Then _
CommandBars.ExecuteMso ("SlideTransitionOnMouseClick")
DoEvents
If CommandBars.GetPressedMso("SlideTransitionAutomaticallyAfter") Then _
CommandBars.ExecuteMso ("SlideTransitionAutomaticallyAfter")
DoEvents
CommandBars.ExecuteMso ("SlideTransitionApplyToAll")
DoEvents
opres.Save
opres.Close
strFile = Dir()
Wend
End Sub

Will this run on a MAC?

[John Wilson]

No, but did you say you had a mac?

[abenitez77]

I think it's obvious I did not, but I guess I should have. So the now obvious question is, is there a way to do what I want on a MAC or do i need to move the files to a pc and run it there then copy the files back?

[John Wilson]

You should have and then I wouldn't have wasted an hour!

On a Mac I think you would need to use AppleScript but I am not a Mac programmer.

If you have a PC I would try it there with a few files only to start with.

[abenitez77]

You should have and then I wouldn't have wasted an hour!

On a Mac I think you would need to use AppleScript but I am not a Mac programmer.

If you have a PC I would try it there with a few files only to start with.

John, your time is not wasted. I will be copying the files to a laptop with windows and using your code, then copying the files back to the mac. I am not a mac programmer either.

Thanks for your expertise and time!

[Aussiebear]

Perhaps this applescript might be useful?



tell application "Microsoft PowerPoint"
set target_folder to choose folder with prompt "Select the folder containing your PowerPoint files:"
set powerpoint_files to (get every file of target_folder whose name ends with ".pptx" or name ends with ".ppt")
repeat with a_file in powerpoint_files
open a_file
tell the active presentation
set slide_count to the count of slides
repeat with i from 1 to slide_count
set the_slide to slide i
tell the slide transition of the_slide
set automatically advance after to 0 -- Set automatic advance time to zero
set advance on mouse click to true -- Ensure it advances on mouse click
end tell
end repeat
save
close saving yes
end tell
end repeat
end tell

[Aussiebear]

and finally as a possible update to John's method...


Sub DisableAutoAdvanceForAllSlides()
Dim opres As Presentation
Dim strFile As String
Dim strFolder As String
Dim strSpec As String
Dim osld As Slide
' Specify the file pattern to find PowerPoint files
strSpec = "*.pp*"
' Specify the folder containing the PowerPoint files
strFolder = Environ("USERPROFILE") & "\Desktop\PPTFILES\"
' Get the first file matching the pattern in the folder
strFile = Dir$(strFolder & strSpec)
' Loop through all matching files in the folder
While strFile <> ""
On Error Resume Next ' Enable error handling for opening files
Set opres = Presentations.Open(strFolder & strFile)
On Error GoTo 0 ' Disable error handling after attempting to open
' Check if the presentation was opened successfully
If Not opres Is Nothing Then
' Loop through each slide in the presentation
For Each osld In opres.Slides
With osld.SlideShowTransition
' Disable automatic advance
.AdvanceOnTime = False
.AdvanceAfterTime = 0
' Ensure advance on mouse click is enabled (optional, but good practice)
.AdvanceOnClick = True
End With
Next osld
' Save the changes opres.Save
' Close the presentation
opres.Close
Else
' Inform the user if a file could not be opened
Debug.Print "Could not open file: " & strFolder & strFile
End If
' Get the next file matching the pattern
strFile = Dir$()
Wend
MsgBox "Automatic slide advance has been disabled for all PowerPoint files in the specified folder.", vbInformation
End Sub