Avatar of Jon Bredensteiner
Jon Bredensteiner
Flag for United States of America asked on

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
Microsoft PowerPointVBA

Avatar of undefined
Last Comment
Jon Bredensteiner

8/22/2022 - Mon
John Wilson

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 Bredensteiner

ASKER
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 Bredensteiner

ASKER
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
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
John Wilson

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 Bredensteiner

ASKER
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
ASKER CERTIFIED SOLUTION
John Wilson

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
Jon Bredensteiner

ASKER
Thanks man, that worked great!
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.