Select Text Based on Font and Add to Collection

[John]

Hi there,

I need to make a table of contents from the stories in a series of slides.
Each slide has a single textbox and contains about three or four stories in
the following format:

The Main Header - The rest of the story, The rest of the story, The rest of
the story, The rest of the story, The rest of the story, The rest of the
story, The rest of the story

"The Main Header" is in a different font from all of the other text in the
presentation (including the "The rest of the story, The rest of the story,
The rest of the story, ...." part).

I've written a short bit of code but am unsure of what to do with the
selection bit in particular but also the following chuck it out into a
textbox. Can anyone help.

Thanks

John

Sub MakeContentsTable()

Dim hdrs As Collection
Dim sld As Slide
Dim shp As Shape
Dim newText As String

For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame = msoTrue Then
'If shp.TextFrame.TextRange.Font
'Select any text that is Arial 10
newText = "" ' selected text
'add new text to hdrs collection
hdrs.Add (newText)
End If
Next shp
Next sld

'add new slide with text box
'add hdrs collection to text box

End Sub

 

[David M. Marcovitz]

Here's one way I might approach this:

Sub MakeContentsTable()

Dim hdrs As String
Dim sld As Slide
Dim shp As Shape
Dim myChar As TextRange
Dim numSlides As Long
Dim tcSlide As Slide
Dim tcBox As Shape

For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
For Each myChar In shp.TextFrame.TextRange.Characters
If myChar.Font.Name = "Arial" Then
hdrs = hdrs & myChar
End If
Next myChar
Next shp
Next sld
'MsgBox hdrs

numSlides = ActivePresentation.Slides.Count
Set tcSlide = ActivePresentation.Slides.Add(numSlides + 1, ppLayoutBlank)
Set tcBox = tcSlide.Shapes.AddTextbox(Orientation:
=msoTextOrientationHorizontal, Left:=10, Top:=10, Width:=800, Height:=
600)
tcBox.TextFrame.TextRange.Text = hdrs
ActivePresentation.SlideShowWindow.View.GotoSlide numSlides + 1

End Sub


--
David M. Marcovitz
Director of Graduate Programs in Educational Technology
Loyola College in Maryland
Author of _Powerful PowerPoint for Educators_
http://www.loyola.edu/education/PowerfulPowerPoint/

 

[Steve Rindsberg]

See below

"The Main Header" is in a different font from all of the other text in the
presentation (including the "The rest of the story, The rest of the story,
The rest of the story, ...." part).

I've written a short bit of code but am unsure of what to do with the
selection bit in particular but also the following chuck it out into a
textbox. Can anyone help.

Sub MakeContentsTable()

Dim hdrs As Collection
Dim sld As Slide
Dim shp As Shape
Dim newText As String

For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame = msoTrue Then

' Try this. If nothing changes between the two parts of the text other
' than the font, this should work:
MsgBox osh.TextFrame.TextRange.Runs(1).Text
MsgBox osh.TextFrame.TextRange.Runs(2).Text

if you have multiple paragraphs in one text box, each with a header/story, work
with .Paragraphs instead of the entire text box:

Dim X As Long
For X = 1 To osh.TextFrame.TextRange.Paragraphs.Count
MsgBox osh.TextFrame.TextRange.Paragraphs(X).Runs(1).Text
MsgBox osh.TextFrame.TextRange.Paragraphs(X).Runs(2).Text
Next

 

[John]

This is great. Thanks very much David and Steve. I've ended up use a
mixture of both of your suggests (see below). I've also gone for the
collection route as it seemed easier to add a carriage return after each
item. I also liked the Runs method (David does the myChars bit pick out
each word individually?), but it's not a huge presentation so performance
isn't vital. Anyway, it seems to work ok for my purposes so thanks again to
you both.

Best regards

John

Sub MakeContentsTable()

Dim hdrsCol As New Collection
Dim sld As Slide
Dim shp As Shape
Dim numSlides As Long
Dim tcSlide As Slide
Dim tcBox As Shape

For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame = msoTrue Then
For Each myRun In shp.TextFrame.TextRange.Runs
If myRun.Font.Name = "Arial" _
And myRun.Font.Size = "14" Then
hdrsCol.Add (myRun)
End If
Next myRun
End If
Next shp
Next sld

'MsgBox hdrs
numSlides = ActivePresentation.Slides.Count
Set tcSlide = ActivePresentation.Slides.Add(numSlides + 1,
ppLayoutBlank)
Set tcBox = tcSlide.Shapes.AddTextbox _
(Orientation:=msoTextOrientationHorizontal, _
Left:=10, Top:=75, Width:=600, Height:=400)
tcBox.TextFrame.TextRange.Text = ""
For Each myRun In hdrsCol
tcBox.TextFrame.TextRange.Text = tcBox.TextFrame.TextRange.Text &
vbCr & myRun
Next myRun
With tcBox.TextFrame.TextRange
.Font.Name = "Arial"
.Font.Size = "10"
.ParagraphFormat.Alignment = ppAlignLeft
End With
'ActivePresentation.SlideShowWindow.View.GotoSlide numSlides + 1

End Sub

 

[David M. Marcovitz]

John,

I'm glad we were able to help. As you can see, there are a number of
different ways to do this. The method I used actually went character by
character, so if someone put every other character into the Arial font,
then every other character would show up on your Table of Contents. You
could easily repalce "characters" with "words" or "paragraphs" to go word
by word or paragraph by paragraph.

--David

--
David M. Marcovitz
Director of Graduate Programs in Educational Technology
Loyola College in Maryland
Author of _Powerful PowerPoint for Educators_
http://www.loyola.edu/education/PowerfulPowerPoint/

 

[Steve Rindsberg]

John,

I'm glad we were able to help. As you can see, there are a number of
different ways to do this. The method I used actually went character by
character, so if someone put every other character into the Arial font,
then every other character would show up on your Table of Contents.

And note that using runs, it's not necessary to hardcode Arial 14pt. As long
as the formatting changes between the heading and the body copy (and there are
no other formatting changes) you'll get two runs. Lots of ifs there,
admittedly.

The only other fragile bit I can see is that if the header is the same for two
pieces of body copy, the second one won't get added (can't have duplicates in a
collection).

 

[John]

Thanks once again to you both. I think I will definitely use the different
selection methods in the future. Regarding the dupes in a collection, that
should arise in this case, but I hadn't thought about it so again that will
be good for the future.

Anyway, it's very helpful to get such well thought out replies.

Thanks

John