Every important presentation should have a table of contents (TOC). For some reasons, there is no option in PPT to create it with standard functions. You could find some add-in options, but they are probably too complicated and not free. So let’s see, how you could create a TOC in 3 steps and then update it with one click.

STEP 1. CREATE SECTIONS

Sections are useful by themselves, even if you do not want to create a TOC. They allow you to structure and organize your presentation faster and simpler. It is easier to arrange slides with them, move between slides and so on. To create anew section, just right click on slides panel. Names of the sections will appear in your future TOC.

STEP 2. CREATE A TABLE AS A TOC TEMPLATE

Choose a slide in which you want to see your TOC and just create a table with two columns: one for name of the section, one for number of slides.

STEP 3. USE A VBA CODE TO CREATE/UPDATE YOUR TOC

Run a macro. That’s it, plain and simple. Run this code again and your TOC will be updated.
Do not forget to format the table to match your presentation style.

MAIN STEPS OF THE MACRO

1. DETERMINE SHAPE WITH THE TABLE FOR TOC

For Each shp In Application.ActiveWindow.View.Slide.Shapes     
   If shp.HasTable Then
     <<commands>>     
   End If 
Next shp

This loop goes through all object on the selected slide. For proper work, you must have only one table on a slide. You could also modify the code in a way which will use the name of the selected table.

2. MATCHING NUMBER OF ROWS WITH NUMBER OF SECTIONS

We could modify the number of rows to match it with number of sections:

Do While ActivePresentation.SectionProperties.Count - 1 > shp.Table.Rows.Count
   shp.Table.Rows.Add
Loop

Do While ActivePresentation.SectionProperties.Count - 1 < shp.Table.Rows.Count
     shp.Table.Rows(1).Delete
Loop

3. FILLING THE TABLE

Now we could fill our Table with Sections data:

With ActivePresentation.SectionProperties
     For i = 2 To .Count
         shp.Table.Cell(i - 1, 1).Shape.TextFrame.TextRange.Text = .Name(i)
         shp.Table.Cell(i - 1, 2).Shape.TextFrame.TextRange.Text = .FirstSlide(i)
     Next i
End With

This loop goes through all sections names and first slides numbers and copies them to Table. We do not interested in the first section, because it is useless most of the times.

4. ADD LINKS TO YOUR SECTIONS

These links will work in the Presentation mode (and not in Edit mode). If you want to maintain hyperlinks in PDF, you need just to save your presentation in PDF.

For i = 2 To sectNumb
     'section name col
     With shp.Table.Cell(i - 1, 1).Shape.TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink
         .SubAddress = shp.Table.Cell(i - 1, 2).Shape.TextFrame.TextRange.Text
         .TextToDisplay = shp.Table.Cell(i - 1, 1).Shape.TextFrame.TextRange.Text
     End With
     
     'slide number col     
     With shp.Table.Cell(i - 1, 2).Shape.TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink
         .SubAddress = shp.Table.Cell(i - 1, 2).Shape.TextFrame.TextRange.Text
         .TextToDisplay = shp.Table.Cell(i - 1, 2).Shape.TextFrame.TextRange.Text
     End With
Next i

FULL CODE

Sub update_TOC()
Dim i, sectNumb As Long
Dim shp As Shape

For Each shp In Application.ActiveWindow.View.Slide.Shapes
     If shp.HasTable Then                  
         Do While ActivePresentation.SectionProperties.Count - 1 > shp.Table.Rows.Count
             shp.Table.Rows.Add
         Loop

         Do While ActivePresentation.SectionProperties.Count - 1 < shp.Table.Rows.Count
             shp.Table.Rows(1).Delete
         Loop

         sectNumb = ActivePresentation.SectionProperties.Count
         
         With ActivePresentation.SectionProperties
             For i = 2 To .Count
                 shp.Table.Cell(i - 1, 1).Shape.TextFrame.TextRange.Text = .Name(i)
                 shp.Table.Cell(i - 1, 2).Shape.TextFrame.TextRange.Text = .FirstSlide(i)
             Next i
         End With

         'add hyperlinks
         For i = 2 To sectNumb
             'section name col
             With shp.Table.Cell(i - 1, 1).Shape.TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink                 
                 .SubAddress = shp.Table.Cell(i - 1, 2).Shape.TextFrame.TextRange.Text
                 .TextToDisplay = shp.Table.Cell(i - 1, 1).Shape.TextFrame.TextRange.Text
             End With
                        
             'slide number col
             With shp.Table.Cell(i - 1, 2).Shape.TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink                 
                 .SubAddress = shp.Table.Cell(i - 1, 2).Shape.TextFrame.TextRange.Text
                 .TextToDisplay = shp.Table.Cell(i - 1, 2).Shape.TextFrame.TextRange.Text
             End With
         Next i

         Exit Sub

     End If

 Next shp

 End Sub
Categories
big4macros
Tags
,