I have to do a presentation at university and it needs to be done in PowerPoint - OpenOffice and LaTeX are explicity not allowed. Usually I’m all for Microsoft, but PowerPoint really lacks quite a few things that one would expect to be common in modern presentation software:

  • ability to insert document properties
  • working document properties - somehow I get an error message every time I try to open the document property viewer…
  • changing the language of a presentation (for all slides, etc.) - it’s just a huge W-T-F that you have to use macros or add-ins to do that
  • table of contents slides - it’s incredible that there is no way to automate this in PowerPoint.

LaTeX is a 1000x more user-friendly in that regard to be honest. You can download some packages for free that automate everything that is worth automating and you won’t be bothered with updating all possible things manually everytime. It also usually supports more powerful slides with advanced navigation, etc.

Nonetheless if PowerPoint sucks, then** Visual Basic for Applications for PowerPoint** is one big brainfuck. The level of stupidity and general suckiness of VBA as language and the fact that you somehow don’t find up-to-date documentation about it online (no language specs?) and some braindead decisions in the PowerPoint macro API make it a real PITA to work with..

Anyway, I’ve written a macro to create a Table of Contents slide automatically for a PowerPoint presentation - it also allows for updating it later on and for customizing its title without overwriting it on update:

' create a Table of Contents slide as second slide (but you can move it around afterwards)
' you can use the macro to update an already generated one without it resetting the title or the slide's position
Const TOCTag = "TOC?Level"
Const TOCSlideName = "TOC?Slide"

Sub CreateTOCSlide()
    Dim contentSlide As Slide
    On Error Resume Next
    Set contentSlide = ActivePresentation.Slides(TOCSlideName)

    If contentSlide Is Nothing Then
        Set contentSlide = ActivePresentation.Slides.AddSlide(2, ActivePresentation.Slides(1).CustomLayout)
        contentSlide.Name = TOCSlideName
        contentSlide.Layout = ppLayoutText
        contentSlide.Shapes.title.TextFrame.TextRange.Text = "Table of Contents"
    End If

    UpdateTOCSlide
End Sub

Private Function FindTOCSlideWithTitle(title As String) As Slide
    Dim cSlide As Slide
    For Each cSlide In ActivePresentation.Slides
        If cSlide.Tags(TOCTag) <> "" Then
            If cSlide.Shapes.title.TextFrame.TextRange.Text = title Then
                Set FindTOCSlideWithTitle = cSlide
                Exit Function
            End If
        End If
    Next cSlide
    Set FindTOCSlideWithTitle = Nothing
End Function

Sub UpdateIndentationFromTOC()
    Dim contentSlide As Slide
    On Error Resume Next
    Set contentSlide = ActivePresentation.Slides(TOCSlideName)

    If contentSlide Is Nothing Then
        Exit Sub
    End If

    Dim contentTextRange As TextRange2
    Set contentTextRange = contentSlide.Shapes.Placeholders(2).TextFrame2.TextRange

    Dim p As TextRange2
    For Each p In contentTextRange.Paragraphs()
        Dim cSlide As Slide
        Set cSlide = FindTOCSlideWithTitle(Left(p.Text, Len(p.Text) - 1))
        If Not cSlide Is Nothing Then
            cSlide.Tags.Add TOCTag, p.ParagraphFormat.indentLevel
        End If
    Next p
End Sub

Private Sub UpdateTOCSlide()
    Dim contentSlide As Slide
    On Error Resume Next
    Set contentSlide = ActivePresentation.Slides(TOCSlideName)

    If contentSlide Is Nothing Then
        Exit Sub
    End If

    Dim contentTextRange As TextRange2
    Set contentTextRange = contentSlide.Shapes.Placeholders(2).TextFrame2.TextRange

    contentSlide.Shapes.Placeholders(2).TextFrame2.DeleteText
    contentTextRange.ParagraphFormat.Bullet.Type = ppBulletNumbered

    Dim index As Integer
    index = 1

    For Each pSlide In ActivePresentation.Slides
        Dim tagValue As Integer
        tagValue = Val(pSlide.Tags(TOCTag))
        If tagValue > 0 Then
            contentTextRange.InsertAfter pSlide.Shapes.title.TextFrame.TextRange.Text & vbCrLf
            contentTextRange.Lines(index, 1).ParagraphFormat.indentLevel = tagValue
            contentTextRange.Lines(index, 1).ParagraphFormat.LeftIndent = 40 * tagValue
            'contentTextRange.Lines(index).ParagraphFormat.Bullet.Type = ppBulletNumbered
            index = index + 1
        End If
    Next pSlide
End Sub

Sub ToggleTOCEntrySlide()
    Dim currentSlide As Slide
    Set currentSlide = ActiveWindow.View.Slide

    Dim newValue As String
    If currentSlide.Tags(TOCTag) <> "" Then
        newValue = ""
    Else
        newValue = "1"
    End If
    currentSlide.Tags.Add TOCTag, newValue

    UpdateTOCSlide
End Sub

Private Function ClampIndentLevel(level As Integer) As Integer
    If level < 1 Then
        ClampIndentLevel = 1
    ElseIf level > 5 Then
        ClampIndentLevel = 5
    Else
        ClampIndentLevel = level
    End If
End Function

Sub IndentTOCEntrySlide()
    Dim currentSlide As Slide
    Set currentSlide = ActiveWindow.View.Slide

    currentSlide.Tags.Add TOCTag, ClampIndentLevel(1 + Val(currentSlide.Tags(TOCTag)))

    UpdateTOCSlide
End Sub

Sub UnindentTOCEntrySlide()
    Dim currentSlide As Slide
    Set currentSlide = ActiveWindow.View.Slide

    currentSlide.Tags.Add TOCTag, ClampIndentLevel(Val(currentSlide.Tags(TOCTag)) - 1)
    UpdateTOCSlide
End Sub









' create a Table of Contents slide as second slide (but you can move it around afterwards)
' you can use the macro to update an already generated one without it resetting the title or the slide's position
Sub CreateContentTableSlide()
    Const contentSlideName = "ContentTable"

    Dim contentSlide As Slide
    On Error Resume Next
    Set contentSlide = Nothing
    Set contentSlide = ActivePresentation.Slides(contentSlideName)

    On Error GoTo 0
    If contentSlide Is Nothing Then
        Set contentSlide = ActivePresentation.Slides.AddSlide(2, ActivePresentation.Slides(1).CustomLayout)
        contentSlide.Name = contentSlideName
        contentSlide.Layout = ppLayoutText
        contentSlide.Shapes.Title.TextFrame.TextRange.Text = "Table of Contents"
    End If

    Dim contentTextRange As TextRange
    Set contentTextRange = contentSlide.Shapes.Placeholders(2).TextFrame.TextRange

    With contentTextRange
        .ParagraphFormat.Bullet.Type = ppBulletNumbered
        .Text = ""
    End With

    For Each pSlide In ActivePresentation.Slides
        If (pSlide.Layout = ppLayoutTitle) Or (pSlide.Layout = ppLayoutTitleOnly) Then
        ElseIf pSlide.Name = contentSlideName Then
        Else
            contentTextRange.InsertAfter pSlide.Shapes.Title.TextFrame.TextRange.Text & vbNewLine
        End If
    Next pSlide
End Sub

The most recent version can be found in this .zip file here (TOC.bas).

Some remarks:

  • “On Error Resume Next” - it’s crazy that VBA uses this to control its error handler (this construct dates back to QuickBasic..)
  • VBA doesn’t support normal exception handling it seems
  • what does the set statement do and why is it necessary to use it when dealing with object references - I’ve experienced strange error messages before I started using it
  • VBA doesn’t seem to support a Continue statement (continue as the counterpart to break)
  • The VBA documentation is inside the Access documentation (in case you look for it)

Hopefully this is useful for other poor souls who have to or try to work with PowerPoint’s macro facilities.

Cheers,
  Andreas