0
votes

there

I have a problem in MS PowerPoint. I am currently working with about a dozen files with at least 100 slides in each. I need to create individual slides as individual files for uploading purpose. I got a code to split the file into individual slides. The query is how do i rename those files automatically using the VBA code?

Each slide has a title in a text box, and the shape and size of the title text box is consistent across the decks. How do I ensure the individual files created get saved with the "Title of the slide" as the file name?

As of now, the file is saved as "Original file name.n-n"

Would greatly appreciate your help in this.

Following is the code I found on the Internet to split a slide deck into multiple individual files (one slide eaach, for my purpose):

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
1

1 Answers

0
votes

This would have it pick up the text from the title and use that as the output presentation name:

sSplitPresName = sFolder _
  & oSourcePres.Slides(lWindowStart).Shapes.Title.TextFrame.TextRange.Text _
  & "." & sExt

If the slide doesn't have a title, you'll get an error, so you'd need to test for that and decide how to name the split presentation in that case. Maybe:

sSplitPresName = sFolder _
  & "Slide-" & Cstr(lWindowStart) _
  & "." & sExt

You'd also want to run the slide title through a function that removes any characters that are not valid as filenames in the operating system(s) where the presentation will be viewed.