R is considered the predominant language for data scientist and statisticians. Learn how to use R for your own data science projects.
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
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
Do more with
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
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
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
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.
Thank you JSRWilson for your help! I will test your code today.
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
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
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
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
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
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
Premium Content
You need an Expert Office subscription to comment.Start Free Trial