Summary Page Based on Text Box text font color.

[leaning]

Hello!

I found a routine (InsertSummaryPage by Joel Jeffery) that creates a Summary Slide for PowerPoint. It goes through each slide that you have selected, and puts all the titles into a summary page/TOC along with the slide number.

I like it, but I was wondering if there was something similar out there that would:
1) Look in every slide's text boxes.
2) If the text is red and bolded, copy that text and slide number to a summary slide.


I appreciate any help.

Regards, Leaning

[John Wilson]

Probably not too difficult but we have a totally free AddIn that might do what you want
http://www.pptalchemy.co.uk/summary2007.html

Works in versions from 2007

[leaning]

John,

I appreciate your help. I looked at your AddIn, and it does almost exactly what Joel Jeffery's does with some exceptions (yours does slide # and then title and no hyperlinks; his does title then slide number with or without hyperlinks.)

I use PowerPoint slides for college study notes. So, I have text boxes (as much as 30 on a slide) that have different topics/ideas. When it comes time for a test, etc. I can use those notes, but there are 200+ slides and it takes forever to find one idea out of 30 on a slide of 200. So I was copying all the ideas into the title box and then running the macro to make the summary. It works OK, except I still have to pore over the summary page to find what I need.

So I need an index like you find at the back of books. One idea and then the slide it is on. The summary page will be longer, but then I can just jump right to that idea.

My idea was to go through each text box, find the critical word or phrase, bold it and make it red, then run the routine to look for bold red words in all text boxes. It would make the index in slide order, so I will have to move it to Excel or something, get it into alphabetical order, and then move it back.

Anyway, that's the full story. Please me know what other ideas you have.

Regards,
Leaning

[John Wilson]

I haven't looked at the AddIn for a while but I am pretty sure it can create hyperlinks and allows you to tag the slides you need to include.

Here's the basis of the code to make what you need (If I have understood). It will need some error trapping


Sub StartHere()
Dim osld As Slide
Dim oshp As Shape
Dim rayTitles() As String
Dim i As Integer
ReDim rayTitles(1 To 1)
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
For i = 1 To oshp.TextFrame.TextRange.Runs.Count
With oshp.TextFrame.TextRange.Runs(i).Font
If .Color.RGB = vbRed And .Bold = True Then
rayTitles(UBound(rayTitles)) = oshp.TextFrame.TextRange.Runs(i) & "\" & osld.SlideIndex
ReDim Preserve rayTitles(1 To UBound(rayTitles) + 1)
End If
End With
Next i
End If
End If
Next oshp
Next osld
ReDim Preserve rayTitles(1 To UBound(rayTitles) - 1)
Call mySort(rayTitles)
Call make_sum(rayTitles)
End Sub


Function mySort(ArrayIn As Variant) As Variant
Dim b_Cont As Boolean
Dim lngCount As Long
Dim strSwap As String
Do
b_Cont = False
For lngCount = LBound(ArrayIn) To UBound(ArrayIn) - 1
If ArrayIn(lngCount) > ArrayIn(lngCount + 1) Then
strSwap = ArrayIn(lngCount)
ArrayIn(lngCount) = ArrayIn(lngCount + 1)
ArrayIn(lngCount + 1) = strSwap
b_Cont = True
End If
Next lngCount
Loop Until Not b_Cont
End Function


Sub make_sum(rayInstring As Variant)
Dim osld As Slide
Dim i As Integer
For Each osld In ActivePresentation.Slides
If osld.Tags("SUM") = "YES" Then
osld.Delete
Exit For
End If
Next osld
Set osld = ActivePresentation.Slides.Add(1, ppLayoutText)
osld.Tags.Add "SUM", "YES"
osld.Shapes(2).TextFrame2.AutoSize = msoAutoSizeTextToFitShape
osld.Shapes(2).TextFrame.Ruler.TabStops.Add ppTabStopLeft, 550
With osld
For i = 1 To UBound(rayInstring)
.Shapes(2).TextFrame.TextRange = .Shapes(2).TextFrame.TextRange _
& Split(rayInstring(i), "\")(0) _
& vbTab & Split(rayInstring(i), "\")(1) & vbCrLf
Next i
End With
End Sub

[leaning]

John,

That is really sweet! I am still playing around with it, and I have 200 pages to bold/red, so that will take a while. The only tweaks I can see are in how it does the Index:

Jo
Blocks
2
Parallax error

2

So, for Jo Blocks, both words should be on the same line and then it is actually on page 1, not 2. The index is 1, and it pushed the Jo Blocks page to 2. So the whole index is off by 1.

And then for Parallax Error, it put a line feed and then the slide number so there is a gap there.

(I attached a screen capture to show it better.)

It's funny because when I copy that section to this forum, it looks great:

Inside micrometer 5
Jenny calipers 5
Jo blocks 2
Johansson gauges 2
MBNQA 220
Micrometers 5
Muda 220
Ohno 220
Outside micrometer 5
PDF: 231
Parallax error 2
Pneumatic gages 3

Any ideas?

Regards,

Leaning

[leaning]

John,

I removed the vbtab from this line and it seems to make it look better. I can't figure out the best place in the code to put the -1, so the slides numbers are right in the index.

Can you help with that?


For i = 1 To UBound(rayInstring)
.Shapes(2).TextFrame.TextRange = .Shapes(2).TextFrame.TextRange & Split(rayInstring(i), "\")(0) & ": " & Split(rayInstring(i), "\")(1) & vbCrLf
Next i


Regards,

Leaning

[John Wilson]

Rather than remove the vbTab make to value of the added tab smaller This line places it as 550 try 450

osld.Shapes(2).TextFrame.Ruler.TabStops.Add ppTabStopLeft, 550

I don't see how the index can be off are you sure you don't mean slide NUMBER and you have started from zero? If so in the code change osld.SlideIndex to osld.SlideNumber

[leaning]

All,


Sub StartHere()
Dim osld As Slide
Dim oshp As Shape
Dim rayTitles() As String
Dim i As Integer
ReDim rayTitles(1 To 1)
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
For i = 1 To oshp.TextFrame.TextRange.Runs.Count
With oshp.TextFrame.TextRange.Runs(i).Font
If .Color.RGB = vbRed And .Bold = True Then
rayTitles(UBound(rayTitles)) = oshp.TextFrame.TextRange.Runs(i) & "\" & osld.SlideNumber + 1
ReDim Preserve rayTitles(1 To UBound(rayTitles) + 1)
End If
End With
Next i
End If
End If
Next oshp
Next osld
ReDim Preserve rayTitles(1 To UBound(rayTitles) - 1)
Call mySort(rayTitles)
Call make_sum(rayTitles)
End Sub


Function mySort(ArrayIn As Variant) As Variant
Dim b_Cont As Boolean
Dim lngCount As Long
Dim strSwap As String
Do
b_Cont = False
For lngCount = LBound(ArrayIn) To UBound(ArrayIn) - 1
If ArrayIn(lngCount) > ArrayIn(lngCount + 1) Then
strSwap = ArrayIn(lngCount)
ArrayIn(lngCount) = ArrayIn(lngCount + 1)
ArrayIn(lngCount + 1) = strSwap
b_Cont = True
End If
Next lngCount
Loop Until Not b_Cont
End Function


Sub make_sum(rayInstring As Variant)
Dim osld As Slide
Dim i As Integer
For Each osld In ActivePresentation.Slides
If osld.Tags("SUM") = "YES" Then
osld.Delete
Exit For
End If
Next osld
Set osld = ActivePresentation.Slides.Add(1, ppLayoutText)
osld.Tags.Add "SUM", "YES"
osld.Shapes(2).TextFrame2.AutoSize = msoAutoSizeTextToFitShape
osld.Shapes(2).TextFrame.Ruler.TabStops.Add ppTabStopLeft, 450
With osld
For i = 1 To UBound(rayInstring)
.Shapes(2).TextFrame.TextRange = .Shapes(2).TextFrame.TextRange & Split(rayInstring(i), "\")(0) & ": " & Split(rayInstring(i), "\")(1) & vbCrLf
Next i
End With
End Sub



John Wilson is the man for this. I just tweaked it to what works for me:
1) Put the colon in vice the vbtab. That way the slide numbers are right next to the words instead of having to trace a straight line from the words across the page to the associated slide number.
2) Switched the pptabStopLeft to 450 from 550. I have no idea what that does, but it didn't hurt, so I 'm good. :)
3) Added +1 to osld.SlideNumber. So when you run the macro and it adds the index as Slide 1, it pushes your data slides to Slide 2+. So now the index reflects the true slide number of where that index item is.

There is probably a better way to optimize this code. If anyone has any ideas, please let me know.

Again, John rules. :) Thanks!

Regards,

Leaning

[leaning]

Hello. Back again with this thread.
When this macro runs, it treats capitalized words different than words that start with lowercase. Can this be modified so that it alphabetizes regardless of what case the initial letter is?
I appreciate your help!
Regards,
Leaning