1: '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
2: ''' InsertSummary()
3: ''' by Joel Jeffery (http://joelblogs.co.uk) August 2010
4: ''' Creates a Summary Slide for PowerPoint 2010
5: ''' (and probably 2007 too!)
6: ''' Depends: Requires QSortInPlace by Chip Pearson
7: ''' Usage: Select Slides (e.g. in Slide Sorter) and run
8: ''' this macro.
9: ''' License: Creative Commons Public Domain 2010
10: '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
11: Sub InsertSummary(Optional CreateHyperlinks As Boolean)
12: Dim i As Integer
13: Dim strSel As String, strTitle As String
14: Dim summary As Slide
15:
16: 'Only run if we've got something selected
17: If ActiveWindow.Selection.SlideRange.Count > 0 Then
18: 'Array to hold the order of the slides...
19: 'We do this or we build the ToC in the order
20: 'in which the slides were selected :)
21: Dim slideOrder() As Integer
22:
23: 'Size this to the number of slides selected
24: ReDim slideOrder(1 To ActiveWindow.Selection.SlideRange.Count)
25:
26: 'Collect all the IDs of the selected slides
27: For i = 1 To ActiveWindow.Selection.SlideRange.Count
28: slideOrder(i) = ActiveWindow.Selection.SlideRange(i).SlideIndex
29: Next
30:
31: 'Sort them with the QSort Algorithm
32: 'By Chip Pearson, www.cpearson.com, chip@cpearson.com
33: QSortInPlace slideOrder
34:
35: 'Iterate over the slides in Index order
36: For o = 1 To UBound(slideOrder)
37: If ActivePresentation.Slides(slideOrder(o)).Shapes.HasTitle Then
38: 'Build up the ToC Text
39: strTitle = ActivePresentation.Slides(slideOrder(o)).Shapes.Title.TextFrame.TextRange.Text
40: strSel = strSel & strTitle & vbCrLf
41: End If
42: Next
43:
44: 'Create the summary slide before the first slide in the selection
45: Set summary = ActivePresentation.Slides.Add(slideOrder(1), ppLayoutText)
46: 'Add the title
47: summary.Shapes(1).TextFrame.TextRange = "Module Summary"
48: 'Add the ToC text
49: summary.Shapes(2).TextFrame.TextRange = strSel
50:
51: ' By popular demand...! ;)
52: If CreateHyperlinks Then
53: 'Add Hyperlinks :)
54: For o = 1 To UBound(slideOrder)
55: If ActivePresentation.Slides(slideOrder(o) + 1).Shapes.HasTitle Then
56: 'Build up the ToC Text
57: strTitle = ActivePresentation.Slides(slideOrder(o) + 1).Shapes.Title.TextFrame.TextRange.Text
58: With summary.Shapes(2).TextFrame.TextRange.Paragraphs(o).ActionSettings(ppMouseClick)
59: .Action = ppActionHyperlink
60: .Hyperlink.Address = ""
61: .Hyperlink.SubAddress = ActivePresentation.Slides(slideOrder(o) + 1).SlideID & "," & ActivePresentation.Slides(slideOrder(o) + 1).SlideIndex & "," + strTitle
62: End With
63: End If
64: Next
65: End If
66: End If
67: End Sub
68:
69: '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
70: ''' InsertSummaryWithHyperlinks()
71: ''' by Joel Jeffery (http://joelblogs.co.uk) August 2010
72: ''' Creates a Summary Slide for PowerPoint 2010
73: ''' (and probably 2007 too!) with Hyperlinks
74: ''' Usage: Select Slides (e.g. in Slide Sorter) and run
75: ''' this macro.
76: ''' License: Creative Commons Public Domain 2010
77: '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
78: Sub InsertSummaryWithHyperlinks()
79: InsertSummary CreateHyperlinks:=True
80: End Sub