This code snippet adds a Agenda slide to the beginning
of presentation and picks up slide titles in the active presentation and
assigns hyperlinks to them. You would have to resize the font size after
the links are created if there are a large number of slides -- that is
left as exercise.
'
--------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
'
--------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
'
--------------------------------------------------------------------------------
Sub AgendaLinks() Dim oSld As Slide Dim oShp As Shape Dim oAgenda As TextRange Dim x As Integer
' Add a slide to the beginning of presentation ActivePresentation.Slides.Add 1, ppLayoutText With ActivePresentation.Slides(1) .Shapes(1).TextFrame.TextRange = "Agenda Slide" Set oAgenda = .Shapes(2).TextFrame.TextRange End With
oAgenda = ""
For Each oSld In ActivePresentation.Slides
' Does the slide have title placeholder? If oSld.Shapes.HasTitle Then
' Get the reference to the title shape on the slide Set oShp = oSld.Shapes.Title
' Check if the placeholder has any text in it. If oShp.TextFrame.TextRange.Text = "" Then
oAgenda = oAgenda & "Slide " & oSld.SlideIndex & Chr(13) Else
oAgenda = oAgenda & oShp.TextFrame.TextRange.Text & Chr(13) End If Else
oAgenda = oAgenda & "Slide " & oSld.SlideIndex & Chr(13) End If
Next oSld
' Add hyperlinks to the titles. For x = 1 To oAgenda.Sentences.Count Set oSld = ActivePresentation.Slides(x) With oAgenda.Sentences(x) _ .ActionSettings(ppMouseClick).Hyperlink
.Address = "" ' Hyperlink - Slide ID, Slide Index, Slide Title .SubAddress = oSld.SlideID & "," & _ oSld.SlideIndex & "," & _ oAgenda.Sentences(x).Text End With Next x
' Delete the first one because it points to the agenda slide.
oAgenda.Sentences(1).Delete End Sub
|