Save All Macro For PowerPoint...

[bbbb1234]

I have this macro in Excel:
Sub SaveAll()
Dim xWb As Workbook
For Each xWb In Application.Workbooks
If Not xWb.ReadOnly And Windows(xWb.Name).Visible Then
xWb.Save
End If
Next
End Sub

As can been seen, it works like a champ for saving all open Excel files and I have been using it for six plus months. Now I want to create one for PowerPoint but since I am not a VBA master, I am hoping someone in this forum can provide the code to SaveAll open files in PowerPoint that is equivalent to the Excel macro above.

Help would be greatly appreciated!!!!!

Many thanks in advance!!!

 

[t0ny84]

I have this macro in Excel:
Sub SaveAll()
Dim xWb As Workbook
For Each xWb In Application.Workbooks
If Not xWb.ReadOnly And Windows(xWb.Name).Visible Then
xWb.Save
End If
Next
End Sub

As can been seen, it works like a champ for saving all open Excel files and I have been using it for six plus months. Now I want to create one for PowerPoint but since I am not a VBA master, I am hoping someone in this forum can provide the code to SaveAll open files in PowerPoint that is equivalent to the Excel macro above.

Help would be greatly appreciated!!!!!

Many thanks in advance!!!

Hi bbbb1234,

First you will need to turn on the Developer Tab in PowerPoint to get to the VBA Editor.

The following code should do the same as your Excel VBA code but for PowerPoint.

Sub SaveAllPowerPoints()
    Dim xPPT As Object ' PowerPoint.Application
    Dim xPresentation As Object ' PowerPoint.Presentation
    
    ' Check if PowerPoint is running
    On Error Resume Next
    Set xPPT = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
    
    ' If PowerPoint is not running, create a new instance
    If xPPT Is Nothing Then
        Set xPPT = CreateObject("PowerPoint.Application")
    End If
    
    ' Loop through each open presentation and save if not read-only
    For Each xPresentation In xPPT.Presentations
        If Not xPresentation.ReadOnly Then
            xPresentation.Save
        End If
    Next xPresentation
    
    ' Clean up
    Set xPresentation = Nothing
    Set xPPT = Nothing
End Sub

 

[bbbb1234]

Hi t0ny84 -
That worked like a champ! Thanks for the response and macro code!!!
...Brett