VBA:Generating Table of contents for MS Word

[Deeppurple]

Hi all,

I am able to generate the TOC from the document but not the way I need. What i want is something like this. I want to put only first few words of every paragraph on the word document as part of TOC. As of now the whole paragraph becomes part of TOC. How do I do this?

TIA

 

[RobBroekhuis]

"First few words" is a pretty vague definition... I don't think Word will give you that capability as a standard. You could write, with some effort, a VBA routine to generate such a TOC, but it wouldn't automatically update - i.e., you'd have to run the macro every time you wanted to print.
Rob

 

[Deeppurple]

Can you please elaborate on that, Rob. How do I generate TOC with only first 4 words on every paragraph?

-TIA

 

[RobBroekhuis]

What I had in mind was writing a macro that finds each paragraph that needs to go into the TOC (by looking for a particular style, for example) and builds the TOC in a hard-text form. By using bookmarks, the macro could detect a previous version of its TOC, and delete it before recreating one. Again, you'd need to run this every time before you print, since otherwise page numbers may be out of sync.
Rob

 

[Deeppurple]

Here is what I did. What i am doing is I am taking first sentence of every paragraph which is 'Bold' and adding it to the TOC. But I cannot see anything in Bookmarks. How do I find out if TOC already exists while recreating it? However the below code is working fine.

    Dim i As Integer
    Dim j As Long
    Dim rngTmp As Word.Range
    Dim rngTmp2 As Word.Range
    Dim para As Word.Paragraph
    Dim strDocContent As String
    Dim strTmp As String
    Set objActiveDoc = objWrd.ActiveDocument
    i = 0
    j = 0
    If objActiveDoc.TablesOfContents.Count = 0 Then
        If objActiveDoc.Paragraphs.Count > 0 Then
            For Each para In objActiveDoc.Paragraphs
                If para.Range.Words.Count > 0 Then
                    If para.Range.Font.Bold Then
                    
                        i = 0
                        j = 0

                        i = para.Range.Sentences(1).Words.Count
                        If i <> 0 Then
                            For i = 1 To para.Range.Sentences(1).Words.Count
                                If para.Range.Words(i).Text <> &quot;&quot; Then
                                    j = j + Len(para.Range.Words(i).Text)
                               End If
                            Next
                            Set rngTmp2 = objActiveDoc.Range(para.Range.Start, para.Range.Start + j)
                            strTmp = rngTmp2.Text
                            
                            objActiveDoc.TablesOfContents.MarkEntry Range:=rngTmp2, Entry:=strTmp, EntryAutoText:=&quot;&quot;, _
                                TableId:=&quot;C&quot;, Level:=1
                                      End If
                    End If
                End If
            Next
            Set rngTmp = objActiveDoc.Range(Start:=0, End:=0)
            With objActiveDoc
                .TablesOfContents.Add Range:=rngTmp, RightAlignPageNumbers:= _
                    True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
                    LowerHeadingLevel:=3, UseFields:=True, IncludePageNumbers:=True, AddedStyles:=False, _
                    UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseOutlineLevels:=False
                
                .TablesOfContents(1).TabLeader = wdTabLeaderDots
                .TablesOfContents.Format = wdIndexIndent
                
            End With
            With rngTmp
                .Collapse wdCollapseStart
                .InsertBefore &quot;Table of Contents&quot;
                .InsertParagraphAfter
                .Style = wdStyleHeading2
            End With
        Else
            'No content on the document
        End If

-

 

[RobBroekhuis]

You'd have to add the bookmarks programmatically when you generate the TOC. Looks like you're well on your way to getting this tackled!
Rob