Hi John, and readers, I'm hoping you can help me on the code below.
It creates a slide with a table of contents. You select slides first then click choose the macro (hyperlinked or not).
I get an error message "Compile error: Sub or Function not defined" at the text I put in red font (half way down).
So grateful for any help, and thank you for your time.
===VBA CODE START===
Option Explicit
Sub Agenda(Optional Hyperlinks As Boolean)
Dim i As Integer
Dim o As Integer
Dim strSel As String
Dim strTitel As String
Dim strAgendaTitel As String
Dim slAgenda As Slide
Dim intPos As Integer
Dim SlideFollow() As Integer
On Error Resume Next
If ActiveWindow.Selection.SlideRange.Count > 0 Then
ReDim SlideFollow(1 To ActiveWindow.Selection.SlideRange.Count)
'Select position for content slides
intPos = InputBox("Which slides should the agenda be inserted before?", "Position of the agenda")
'Cancel if the value is greater than the number of slides
If intPos > ActivePresentation.Slides.Count Then
MsgBox "The selected value is greater than the number of slides in the presentation.“
Exit Sub
End If
'Enter the title of the content slide
strAgendaTitel = InputBox("What heading do you want for the content slide?", "Enter titles")
'Determining the IDs of selected slides
For i = 1 To ActiveWindow.Selection.SlideRange.Count
SlideRange(i) = ActiveWindow.Selection.SlideRange(i).SlideIndex
Next
For o = 1 To UBound(SlideRange)
If ActivePresentation.Slides(SlideRange(o)).Shapes.HasTitle Then
'Build up the ToC Text
strTitel = ActivePresentation.Slides(SlideRange (o)).Shapes.Title.TextFrame.TextRange.Text
strSel = strSel & strTitel & vbCrLf
End If
Next
'Insert blank slides where you want, enter titles and headings
Set slAgenda = ActivePresentation.Slides.Add(intPos, ppLayoutText)
slAgenda.Shapes(1).TextFrame.TextRange = strAgendaTitel
slAgenda.Shapes(2).TextFrame.TextRange = strSel
'Insert Hyperlinks
If Hyperlinks Then
For o = 1 To UBound(FolienFolge)
If ActivePresentation.Slides(SlideRange(o) + 1).Shapes.HasTitle Then
'Build up the ToC Text
strTitel = ActivePresentation.Slides(SlideRange(o) + 1).Shapes.Title.TextFrame.TextRange.Text
With slAgenda.Shapes(2).TextFrame.TextRange.Paragraphs(o).ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
.Hyperlink.Address = ""
.Hyperlink.SubAddress = ActivePresentation.Slides(SlideRange(o) + 1).SlideID & "," & ActivePresentation.Slides(SlideRange(o) + 1).SlideIndex & "," + strTitel
End With
End If
Next
End If
End If
End Sub
Sub DirectoryWithoutHyperlinks()
'Insert directory without hyperlinks
Agenda (False)
End Sub
Sub DirectoryWithHyperlinks()
'Insert Directory with Hyperlinks
Agenda (True)
End Sub
===VBA CODE END===