Hi all,
I have a Powerpoint presentation file that I rewrite every month or so and populate it with updated slide information. I then convert this into a pdf to distribute to various email addresses so that they are updated with the most up-to-date news. Each slide is specific to a certain topic e.g Bedroom, Office, Kitchen and Bathroom.
What I would like to do is archive the slides in a way so that I have a revision history of all the updates.
My idea is to copy the individual slides from the month's Powerpoint and put them into separate Powerpoints for each of the categories for example a file called Bedroom - Slide Archive where I would have December, January and February's slides copied over. In most cases, the category will only have 1 slide, but sometimes there will be months where a category will have 2 slides devoted to it - ideally I would like these to be grouped together in 1 file. Currently the VBA code I have at the bottom splits the Powerpoint into a pre-defined number of slides per file (so I set it to 1). How can I amend this code so that I can group slides together where they are part of the same category? Could I use the Slide Title identified in Powerpoint's Outline View to group them?
This would obviously take quite a bit of manual input to copy them over which would massively increase with the addition of extra categories. I also acknowledge this is open to human error mistakes.
Is there any software / plug-ins etc that I could use to quickly split Powerpoints or PDFs into individual slides?
I can consider paid options too.
Kind regards,
Code:
Sub SplitFile()
Dim lSlidesPerFile As Long
Dim lTotalSlides As Long
Dim oSourcePres As Presentation
Dim otargetPres As Presentation
Dim sFolder As String
Dim sExt As String
Dim sBaseName As String
Dim lCounter As Long
Dim lPresentationsCount As Long ' how many will we split it into
Dim x As Long
Dim lWindowStart As Long
Dim lWindowEnd As Long
Dim sSplitPresName As String
On Error GoTo ErrorHandler
Set oSourcePres = ActivePresentation
If Not oSourcePres.Saved Then
MsgBox "Please save your presentation then try again"
Exit Sub
End If
lSlidesPerFile = CLng(InputBox("How many slides per file?", "Split Presentation"))
lTotalSlides = oSourcePres.Slides.Count
sFolder = ActivePresentation.Path & "\"
sExt = Mid$(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") + 1)
sBaseName = Mid$(ActivePresentation.Name, 1, InStr(ActivePresentation.Name, ".") - 1)
If (lTotalSlides / lSlidesPerFile) - (lTotalSlides \ lSlidesPerFile) > 0 Then
lPresentationsCount = lTotalSlides \ lSlidesPerFile + 1
Else
lPresentationsCount = lTotalSlides \ lSlidesPerFile
End If
If Not lTotalSlides > lSlidesPerFile Then
MsgBox "There are fewer than " & CStr(lSlidesPerFile) & " slides in this presentation."
Exit Sub
End If
For lCounter = 1 To lPresentationsCount
' which slides will we leave in the presentation?
lWindowEnd = lSlidesPerFile * lCounter
If lWindowEnd > oSourcePres.Slides.Count Then
' odd number of leftover slides in last presentation
lWindowEnd = oSourcePres.Slides.Count
lWindowStart = ((oSourcePres.Slides.Count \ lSlidesPerFile) * lSlidesPerFile) + 1
Else
lWindowStart = lWindowEnd - lSlidesPerFile + 1
End If
' Make a copy of the presentation and open it
sSplitPresName = sFolder & sBaseName & _
"_" & CStr(lWindowStart) & "-" & CStr(lWindowEnd) & "." & sExt
oSourcePres.SaveCopyAs sSplitPresName, ppSaveAsDefault
Set otargetPres = Presentations.Open(sSplitPresName, , , True)
With otargetPres
For x = .Slides.Count To lWindowEnd + 1 Step -1
.Slides(x).Delete
Next
For x = lWindowStart - 1 To 1 Step -1
.Slides(x).Delete
Next
.Save
.Close
End With
Next ' lpresentationscount
NormalExit:
Exit Sub
ErrorHandler:
MsgBox "Error encountered"
Resume NormalExit
End Sub