Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Powerpoint TOC Table of Contents 1

Status
Not open for further replies.

PWD

Technical User
Jul 12, 2002
823
GB
Good morning. I haven't seen any code to do this so I've started my own but even having just started it looks a bit clunky. I've created an array of words that will appear on each slide and make up part of each line of contents, called "TitleNames". I was thinking of building another array that corresponds the word to the slide number and then trying to build up some sort of TOC from there on slide 2. Is there any way to avoid 'Selecting' each slide in order to examine its contents?

Code:
For x = 3 To 11

    ActivePresentation.Slides.Range("Slide " & x).Select
        
    Set oSld = ActivePresentation.Slides(Application.ActiveWindow.Selection.SlideRange.SlideIndex)
    
    For Each TitleName In TitleNames
    
    
                Set MyText = oSld.Shapes("TextBox Title") 'Each slide has a text box called "TextBox Title"
                
                If InStr(MyText.TextFrame.TextRange, TitleName) Then 'The heading has been found in the 'Title'
                    b = x 'Slide Number '(This was just testing as I built up the code)
                    Contents(x - 3) = TitleName 'New Array of found Titles
                    
                    Exit For    'Heading has been found in the Title
                End If
                
    Next TitleName
   
Next x 'Slide number

Am I barking up the wrong tree?



Many thanks,
D€$
 

hi,

BTW, you seem to be referring to an INDEX, rather than a TOC.

Here's where I would start. Use the Watch Window to DISCOVER what's going on with each object on your slide faq707-4594
Code:
Sub test()
    Dim oSld As Slide, oShp As Shape, b, x, Contents() As String
    
    For Each oSld In ActivePresentation.Slides
        With oSld
            For Each oShp In .Shapes
                Debug.Print oSld.Name, oShp.Name, oShp.TextFrame.TextRange
                
                If InStr(oShp.TextFrame.TextRange, oShp.Name) Then 'The heading has been found in the 'Title'
                    b = x 'Slide Number '(This was just testing as I built up the code)
                    Contents(x - 3) = oShp.Name 'New Array of found Titles
                End If
            Next
        End With
    Next

End Sub


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Hi Skip, not ignoring you just doing more routine stuff :(

I can't think what I thought I'd used the array "Contents" for so I've cut that out of the code. (I hope) I've taken note of your code & it looks like this now (BTW I'm not sure how I should DIM "TitleNames")

Code:
Sub ContentsPage()

Dim x, SlideCount As Integer

TitleNames = Array("Methodology", "blah", "blah", "blah", "blah", "blah" _
, "blah", "blah", "blah", "blah", "blah")

SlideCount = ActivePresentation.Slides.Count

For x = 3 To SlideCount - 1 'There's an "End" page

    With ActivePresentation.Slides.Range("Slide " & x)
    Debug.Print ("Slide " & x)

        For Each TitleName In TitleNames
            
            Set MyText = .Shapes("TextBox Title") 'Each slide has a text box called "TextBox Title"
                    
            If InStr(MyText.TextFrame.TextRange, TitleName) Then 'The heading has been found in the 'Title'
            Exit For    'Heading has been found in the Title
            End If
                    
        Next TitleName
    
    End With 'Slide # "x"
    
    With ActivePresentation.Slides.Range("Slide 2")
   
        .Shapes("TextBox ContentsSlideNo" & x - 2).TextFrame.TextRange = "Slide " & x
     
            Select Case TitleName
            Case "Methodology"
            Description = "** Methodology"
            Case .......
            Case Else
            End Select

    On Error Resume Next ' Something may not work
     
     .Shapes("TextBox ContentsSlideTitle" & x - 2).TextFrame.TextRange = "* " & Description
     
    End With '(Slide 2)
   
Next x 'Slide number

End Sub

It seems to work but I'm still really green with PowerPoint vba.

Many thanks,
D€$
 


There is no OBJECT called TitleNames???

Your textboxes are in the collection os shapes. Use the Watch Window to figure out what property of the shape defines your textbox. I'd look at the type property. It is why my code loops thru the slides and within each slide, loops thru the shapes.

So what's the objective of this exersize?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Hi Skip. Basically I'm trying to write code that will produce an index (TOC?) of the slides on slide 2. For different projects there may be different numbers of slides and my (internal) customers want this index to reflect that flexibility. Each slide will have a textbox named "Textbox Title", so I only want to look in there; there are many, many objects & textboxes on each slide.

It appears to be doing what I want - quickly :)

Many thanks,
D€$
 
Yessir! Thanx. I've now adapted the rest of my PowerPoint code (I've only just started - with this project) to avoid
Code:
 .Select
As for the
Code:
 SlideIndex
this was, as you might have guessed, code that I got from "out there" that enabled me to get started.

Many thanks,
D€$
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top