Automatic Switchboard Creation

[burtburt]

I need to create a navigation switchboard. What I'd like to do is have a macro that can insert a switchboard slide that has bullet lists of links to all the Title slides in the presentation. Each bullet on the switchboard will be the title text of the titles slides. And each slide in the presentation would have a shape with a link to go back to the switchboard.

It should be pretty easy to build. But I wanted to see if anyone had done it already. I looked in the KB but didn't see any ppt macros. Perhaps I'm in the wrong spot.

If no one has anything for this, I'll post what I come up with here. Just wanted to see what the guru's out there have come up with first. Don't want to re-invent the wheel.

Thx.

[burtburt]

Ok. No responses so here's my first cut at this:

Sub AutoAgendaSwitchboard()

Dim i As Integer, j As Integer, intTextLength As Integer
Dim strTitleSlides() As String

ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=2, Layout:=ppLayoutText).SlideIndex
ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
ActiveWindow.Selection.TextRange.Text = "Agenda Switchboard"


j = 0

For i = 3 To ActivePresentation.Slides.Count
If ActivePresentation.Slides(i).Layout = ppLayoutTitle Then
ReDim Preserve strTitleSlides(j)
strTitleSlides(j) = ActivePresentation.Slides(i).Shapes.Title.TextFrame.TextRange.Text
j = j + 1
End If
ActivePresentation.Slides(i).Select
ActivePresentation.Slides(i).Shapes.AddShape(msoShapeActionButtonHome, 696#, 0#, 24#, 24#).Select
With ActiveWindow.Selection.ShapeRange.ActionSettings(ppMouseClick)
With .Hyperlink
.Address = ""
.SubAddress = "Agenda Switchboard"
End With
.SoundEffect.Type = ppSoundNone
.AnimateAction = msoTrue
End With

Next i

For j = 0 To UBound(strTitleSlides)

ActivePresentation.Slides(2).Select
ActivePresentation.Slides(2).Shapes("Rectangle 3").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select

If j = 0 Then
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select

ActiveWindow.Selection.TextRange.Text = strTitleSlides(j)

With ActiveWindow.Selection.TextRange.ActionSettings(ppMouseClick).Hyperlink
.Address = ""
.SubAddress = strTitleSlides(j)
End With

intTextLength = Len(strTitleSlides(j))
Else
ActiveWindow.Selection.TextRange.Characters(Start:=intTextLength + 1, Length:=0).Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=int TextLength + 1, Length:=0).Select

ActiveWindow.Selection.TextRange.Text = Chr(13) + strTitleSlides(j)

With ActiveWindow.Selection.TextRange.ActionSettings(ppMouseClick).Hyperlink
.Address = ""
.SubAddress = strTitleSlides(j)
End With
intTextLength = intTextLength + Len(strTitleSlides(j)) + 1
End If

Next j
End Sub


This obviously needs a launch method, like a toolbar button or menu item.

Also, the bullets on the switchboard will be for slides that have the Title slide layout.

I'll be building on this. But it's a start. I challenge other's to do better :tease:

That's my reverse psychology attempt to get some responses to this.

[Paul_Hossler]

Sounds like you're looking for a table of contents macro
Google "Table of Contents" powerpoint


Lots around, but here one to get you started

http://www.pptfaq.com/FAQ00615.htm


Also PPT has a Summary Slide capability built in that generates a fairly basic TOC

Paul

[burtburt]

I looked at the link you provided. It does something very close to what I want. But the problem is that the code is pwd protected. I'd like to make some changes but can't. mainly adding a link back to the TOC from each slide so I can navigate in the presentation. I do like that you can pick the slides to put in the TOC. I'll see if I can add the functionallity rather than looking for title slides as in the above code.

I looked at the TOC generated from PPT. But it doesn't add links. And, I can't seem to execute that TOC generater programmatically. I tried to record while executing it but it doesn't show up in the recorded module.

Oh well. I guess I'm on my own. Thanks for the link and suggestions though.

[Paul_Hossler]

so I can navigate in the presentation.


If you add an Action button to the master slide, you can have it take you back to the TOC from any slide

This is a bit of VBA that I use to do a TOC, I added an Home Action Button to my master slide after the TOC was generated so that I could set the return to the TOC slide.

There's a 2007 and a 2003 version in -- I don't know if it makes any difference

Paul

[John Wilson]

Does this get you close?
Sub agenda() 'selected slides only
Dim osld As Slide
Dim oshp As Shape
Dim oAgenda As Slide
Dim ostrTitle(100) As String
Dim oID(100) As Integer
Dim Icount As Integer
Dim oTxtR As TextRange
Dim i As Integer
Dim Islidewidth As Integer
Dim Islideheight As Integer
Islidewidth = ActivePresentation.PageSetup.SlideWidth
Islideheight = ActivePresentation.PageSetup.SlideHeight
'error check - no selected slides
If ActiveWindow.Selection.Type = ppSelectionNone Then Exit Sub
'tag selected slides
For i = ActiveWindow.Selection.SlideRange.Count To 1 Step -1
Set osld = ActiveWindow.Selection.SlideRange(i)
osld.Tags.Add "selected", "yes"
Next i
'makes sure that selected slides are in order!
For Each osld In ActivePresentation.Slides
If osld.Tags("selected") = "yes" Then
For Each oshp In osld.Shapes
If oshp.Name = "backbutton" Then oshp.Delete
Next oshp
If osld.Shapes.HasTitle Then
If osld.Shapes.Title.TextFrame.HasText Then
ostrTitle(Icount) = osld.Shapes.Title.TextFrame.TextRange
oID(Icount) = osld.SlideID
'deletes the tag so it does not cause false selections
osld.Tags.Delete ("Selected")
Set oshp = osld.Shapes.AddShape(msoShapeActionButtonHome, Islidewidth - 100, Islideheight - 50, 50, 25)
oshp.ActionSettings(ppMouseClick).Action = ppActionFirstSlide
'so it can be deleted easily
oshp.Name = "backbutton"
Icount = Icount + 1
End If
End If
End If
Next osld
'Add a slide and fill the text and links
Set oAgenda = ActivePresentation.Slides.Add(1, ppLayoutText)
Icount = 0
Do While ostrTitle(Icount) <> ""
Set oTxtR = oAgenda.Shapes(2).TextFrame.TextRange
oTxtR = oTxtR & ostrTitle(Icount) & vbCrLf
oTxtR.ActionSettings(ppMouseClick).Hyperlink.SubAddress = CStr(oID(Icount)) & ",,"
Icount = Icount + 1
Loop
End Sub