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