Hi all. I'm stumped. I have multiple PowerPoints and need an Excel macro to break links. I Update Links when prompted as I open the PPTs, save them as new files with current date, then need to break all links so they don't change later.
I'm trying to write a macro to do the following:
Prompt user to select PowerPoint file
Break Links
Save & Close file
Prompt for next file...break...save, etc.
I want it to do the same thing as if I were to manually break the links, like this:
Open the PowerPoint file
File
Info
Edit Links to Files
Break Link (until all are removed)
Close window
Save & Close PowerPoint.
Am I having trouble because there needs to be something that updates the files as they are opened to be broken? I update the links when I open them to save as a new file, but I can't help but think it's a problem with needing to update again prior to breaking links.
here's my macro...
Sub BreakLinksInPowerPointFiles()
Dim ppApp As Object
Dim ppPresentation As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim fileDialog As fileDialog
Dim filePath As String
Dim moreToBreak As Boolean
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
Set ppApp = CreateObject("PowerPoint.Application")
With fileDialog
.Title = "Select PowerPoint File"
.Filters.Clear
.Filters.Add "PowerPoint Files", "*.pptx"
Do
moreToBreak = False
If .Show = -1 Then
filePath = .SelectedItems(1)
Set ppPresentation = ppApp.Presentations.Open(filePath)
For Each ws In ThisWorkbook.Sheets
ws.Cells.Clear ' Clear any previous data in the Excel sheet
Next ws
' Break links in the PowerPoint presentation
For Each oleObj In ppPresentation.Slides(1).Shapes
If oleObj.Type = 3 Then ' Check if it's a linked OLE object
oleObj.LinkFormat.BreakLink
End If
Next oleObj
ppPresentation.Save
ppPresentation.Close
moreToBreak = True
Else
Exit Do
End If
Loop While moreToBreak
Set ppPresentation = Nothing
ppApp.Quit
Set ppApp = Nothing
End With
MsgBox "You've broken all the links!", vbInformation
End Sub
I'm trying to write a macro to do the following:
Prompt user to select PowerPoint file
Break Links
Save & Close file
Prompt for next file...break...save, etc.
I want it to do the same thing as if I were to manually break the links, like this:
Open the PowerPoint file
File
Info
Edit Links to Files
Break Link (until all are removed)
Close window
Save & Close PowerPoint.
Am I having trouble because there needs to be something that updates the files as they are opened to be broken? I update the links when I open them to save as a new file, but I can't help but think it's a problem with needing to update again prior to breaking links.
here's my macro...
Sub BreakLinksInPowerPointFiles()
Dim ppApp As Object
Dim ppPresentation As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim fileDialog As fileDialog
Dim filePath As String
Dim moreToBreak As Boolean
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
Set ppApp = CreateObject("PowerPoint.Application")
With fileDialog
.Title = "Select PowerPoint File"
.Filters.Clear
.Filters.Add "PowerPoint Files", "*.pptx"
Do
moreToBreak = False
If .Show = -1 Then
filePath = .SelectedItems(1)
Set ppPresentation = ppApp.Presentations.Open(filePath)
For Each ws In ThisWorkbook.Sheets
ws.Cells.Clear ' Clear any previous data in the Excel sheet
Next ws
' Break links in the PowerPoint presentation
For Each oleObj In ppPresentation.Slides(1).Shapes
If oleObj.Type = 3 Then ' Check if it's a linked OLE object
oleObj.LinkFormat.BreakLink
End If
Next oleObj
ppPresentation.Save
ppPresentation.Close
moreToBreak = True
Else
Exit Do
End If
Loop While moreToBreak
Set ppPresentation = Nothing
ppApp.Quit
Set ppApp = Nothing
End With
MsgBox "You've broken all the links!", vbInformation
End Sub
