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.
Top
'
--------------------------------------------------------------------------------
' Copyright ©1999-2007, 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
Top
|