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

Jon Bredensteiner
Jon Bredensteiner used Ask the Experts™
on
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
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
John WilsonCEO PowerPoint Alchemy

Commented:
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 Manager

Author

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 Manager

Author

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
Introduction to R

R is considered the predominant language for data scientist and statisticians. Learn how to use R for your own data science projects.

John WilsonCEO PowerPoint Alchemy

Commented:
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 Manager

Author

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
CEO PowerPoint Alchemy
Commented:
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

Jon BredensteinerProject Manager

Author

Commented:
Thanks man, that worked great!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial