Automatically Create PowerPoint Table of Contents with Slide Links using Python

Question

The Question

I would like to create (automatically) a table of contents, with slide links, in a PowerPoint presentation using Python. Presumably this can be done using python-pptx or similar library. However, I cannot figure out how to do it. Can anyone provide a sample code for how this can be achieved?

Further Context

Ultimately, I am building an automated solution for taking a folder of images, making unique pairs, placing them onto PPT slides, and generating a table of contents with links to the unique pairings. This way, users can quickly navigate to the desired pairings without scrolling through all of the slides. Additionally, the PPT can then be output as a linked PDF for easier distribution and navigation if desired.

Answer 1

This will create a table of contents (TOC) slide with an entry for each slide that contains a title (ie, text in a title placeholder). Each entry will be a hyperlink to the matching slide.

See comments for documentation, such as it is.

Option Explicit

Sub MakeTocFromTitles()
' If there's no TOC slide already, it will add one at Slide 1.
' So you may want to add a blank slide at that position before running this.

' If there's already a TOC slide anywhere in the presentation,
'   it'll use it, in its current position.

' You can mostly format an existing TOC textbox any way you like.
' If you regenerate the TOC, it'll use the original formatting, but
'   because it's adding hyperlinks, it'll use the presentation's theme
'   colors for hyperlinks and followed hyperlinks.
'   (ie and override any font coloring you've assigned)

Dim oSl As Slide
Dim oSh As Shape
Dim sTitleText As String
Dim rngTOCText As TextRange
Dim oTOCShape As Shape
Dim oTOCSlide As Slide

' Check for a TOC slide
For Each oSl In ActivePresentation.Slides
    If oSl.Tags("TOCSlide") = "YES" Then
        Set oTOCSlide = oSl
        Exit For
    End If
Next

' Did we find one? If not, add one and tag it
If oTOCSlide Is Nothing Then
    Set oTOCSlide = ActivePresentation.Slides.AddSlide(1, _
        ActivePresentation.Designs(1).SlideMaster.CustomLayouts(7))
    oTOCSlide.Tags.Add "TOCSlide", "YES"
End If

' Now check for a TOC on the TOCSlide
For Each oSh In oTOCSlide.Shapes
    If oSh.Tags("TOCShape") = "YES" Then
        Set oTOCShape = oSh
        ' delete the text in the shape (does this lose formatting?)
        oTOCShape.TextFrame.TextRange.Delete
        Exit For
    End If
Next

' Did we find a TOCshape? If not, add one:
If oTOCShape Is Nothing Then
    Set oTOCShape = _
        oTOCSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
        0, 0, 720, 720)
    oTOCShape.Tags.Add "TOCShape", "YES"
End If
   
For Each oSl In ActivePresentation.Slides
    ' Don't look at the TOCSlide
    If Not oSl.SlideIndex = oTOCSlide.SlideIndex Then
        ' Pick up the slide's title; skip it if there is none
        Set oSh = GetSlideTitle(oSl)
        If Not oSh Is Nothing Then
            sTitleText = oSh.TextFrame.TextRange.Text
            ' add the text to the end of the ongoing TOC
            ' and add a paragraph ending
            Set rngTOCText = _
                oTOCShape.TextFrame.TextRange.Characters.InsertAfter(sTitleText & vbCrLf)
            ' make the added text a link to the current slide
            rngTOCText.ActionSettings(1).Hyperlink.SubAddress = CStr(oSl.SlideID) _
                & "," & CStr(oSl.SlideIndex) & "," & sTitleText
        End If ' no title on slide
    End If  ' SlideIndex = 1
Next


End Sub

Function GetSlideTitle(oSl As Slide) As Shape
    If oSl.Shapes.HasTitle Then
        Set GetSlideTitle = oSl.Shapes.Title
    End If
End Function