From: John on
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


From: David M. Marcovitz on
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/

"John" <JohnSickOfSpam(a)AOL.net> wrote in
news:OGEEPJRFFHA.3312(a)TK2MSFTNGP15.phx.gbl:

> 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
>
>
>


From: Steve Rindsberg on
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

> '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
>

-----------------------------------------
Steve Rindsberg, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================


From: John on
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

"Steve Rindsberg" <abuse(a)localhost.com> wrote in message
news:VA.00001208.8035713c(a)localhost.com...
> 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
>
>> '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
>>
>
> -----------------------------------------
> Steve Rindsberg, PPT MVP
> PPT FAQ: www.pptfaq.com
> PPTools: www.pptools.com
> ================================================
>
>


From: David M. Marcovitz on
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/

"John" <JohnSickOfSpam(a)AOL.net> wrote in
news:OI0hZeaFFHA.464(a)TK2MSFTNGP15.phx.gbl:

> 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
>
> "Steve Rindsberg" <abuse(a)localhost.com> wrote in message
> news:VA.00001208.8035713c(a)localhost.com...
>> 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
>>
>>> '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
>>>
>>
>> -----------------------------------------
>> Steve Rindsberg, PPT MVP
>> PPT FAQ: www.pptfaq.com
>> PPTools: www.pptools.com
>> ================================================
>>
>>
>
>
>