PowerPoint Macro that saves the file, breaks external file links, and saves as a .ppsx

I have a few PowerPoint files (.pptx) that have many linked charts and objects in them, and to save time on publishing the files as .ppsx (PowerPoint Show) I would like to remove/break all of the links with a macro.

I plan on saving this macro as an add-in using the technique detailed by PPTools here:
Create an ADD-IN with TOOLBARS that run macros

I would like the macro to do the following in this order:
1. save the current file
2. break all external links
3. save the file as a .ppsx in the same folder, using the same name, and automatically replacing an older file if one exists

I am a novice to VBA, and will be very grateful for help with this,
   Jon
Jon BredensteinerProject ManagerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

John WilsonCEO PowerPoint AlchemyCommented:
This should get you well on the way.

Steve's method BTW is a legacy method for pre Ribbon versions. It will still work but you might want to look at a current method. http://www.pptalchemy.co.uk/custom_UI.html

Sub Save_LinkBreak()
Dim oCurrent As Presentation
Dim oPPS As Presentation
Dim strPath As String
Dim strName As String
Dim oshp As Shape
Dim osld As Slide
Set oCurrent = ActivePresentation
If oCurrent.Path = "" Then
MsgBox "This has never been saved!"
Exit Sub
End If
On Error Resume Next
strPath = oCurrent.Path
strName = "\" & Split(oCurrent.Name, ".")(0) & ".ppsx"
For Each osld In oCurrent
For Each oshp In osld.Shapes
oshp.LinkFormat.BreakLink
Next oshp
Next osld
oCurrent.SaveCopyAs strPath & strName, ppSaveAsOpenXMLShow
End Sub

Open in new window

Jon BredensteinerProject ManagerAuthor Commented:
I'm sorry, I had an emergency, and was away from work for the past week...

Thank you JSRWilson for your help!  I will test your code today.
Jon BredensteinerProject ManagerAuthor Commented:
Sorry again for the delay JSRWilson!

I inserted the code you provided into a .pptm file, it did run without any problems, and it saved the file as a .ppsx file in the same folder, but it did not break the worksheet objects links.  The links I am talking about are in the attached screenshot.

Thank you in advance for your help,
   Jon
Links.jpg
OWASP: Threats Fundamentals

Learn the top ten threats that are present in modern web-application development and how to protect your business from them.

Start Today!
John WilsonCEO PowerPoint AlchemyCommented:
There's an error in the code try this

Sub Save_LinkBreak()
Dim oCurrent As Presentation
Dim oPPS As Presentation
Dim strPath As String
Dim strName As String
Dim oshp As Shape
Dim osld As Slide
Set oCurrent = ActivePresentation
If oCurrent.Path = "" Then
MsgBox "This has never been saved!"
Exit Sub
End If
On Error Resume Next
strPath = oCurrent.Path
strName = "\" & Split(oCurrent.Name, ".")(0) & ".ppsx"
For Each osld In oCurrent.Slides
For Each oshp In osld.Shapes
Err.Clear
oshp.LinkFormat.BreakLink
Debug.Print Err
Err.Clear
Next oshp
Next osld
oCurrent.SaveCopyAs strPath & strName, ppSaveAsOpenXMLShow
End Sub

Open in new window

Jon BredensteinerProject ManagerAuthor Commented:
Thank you again for your help JSRWilson.

Your new code does do the following:
1. save the current file
2. break all external links
3. save the file as a .ppsx in the same folder, using the same name, and automatically replacing an older file if one exists

My only concern is that when it's finished the user would still be in the original file, but the links are now removed, so if they hit save again then it will save the original .pptx file without any of the links, which would be bad.

I believe your original code ended with the new .ppsx file open instead of the original .pptx.  Maybe the best thing to do is just close both files at the end of the code to make sure the user doesn't save the original file without worksheet objects links.

What do you think?  I'm definitely open to suggestions.

Thanks again,
   Jon
John WilsonCEO PowerPoint AlchemyCommented:
Maybe this then:

Sub Save_LinkBreak()
Dim oCurrent As Presentation
Dim oPPS As Presentation
Dim strPath As String
Dim strName As String
Dim oshp As Shape
Dim osld As Slide
Set oCurrent = ActivePresentation
If oCurrent.Path = "" Then
MsgBox "This has never been saved!"
Exit Sub
End If
On Error Resume Next
oCurrent.Save
strPath = oCurrent.Path
strName = "\" & Split(oCurrent.Name, ".")(0) & ".ppsx"
For Each osld In oCurrent.Slides
For Each oshp In osld.Shapes
Err.Clear
oshp.LinkFormat.BreakLink
Debug.Print Err
Err.Clear
Next oshp
Next osld
oCurrent.SaveAs strPath & strName, ppSaveAsOpenXMLShow
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Jon BredensteinerProject ManagerAuthor Commented:
Thanks man, that worked great!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft PowerPoint

From novice to tech pro — start learning today.