Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 03-19-2019, 05:42 AM
Cark Cark is offline Powerpoint Slide Archiver Windows 10 Powerpoint Slide Archiver Office 2016
Novice
Powerpoint Slide Archiver
 
Join Date: Mar 2019
Posts: 1
Cark is on a distinguished road
Default Powerpoint Slide Archiver

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
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
PowerPoint Viewer, end of slide click to end. Need ideas how launch multiples slide shows Whooops PowerPoint 0 03-28-2018 01:22 AM
Powerpoint 2016 slide show presenter view as powerpoint 2010 multiple slides at the bottom jomo252 PowerPoint 0 10-04-2017 12:20 PM
My images won't appear in the powerpoint slide cgbethel PowerPoint 1 10-21-2016 06:57 PM
Receive Powerpoint Slide Data by Drag and Drop from Powerpoint to Java App jike27 PowerPoint 0 12-03-2015 08:38 PM
Powerpoint Slide Archiver Powerpoint Slide Transition arandles PowerPoint 1 09-22-2010 12:36 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 10:26 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft