Microsoft Office Forums - View Single Post

RRB · 02-11-2024, 06:27 AM

The challenge: To create a TOC exclusively based on the FN area for a certain chapter of a book in Word.

The problem:
Due to MSoft's extreme AntiFooteNoteIsm, it is not allowing Word to pick up TC fields in the FN area. We need to go about this manually.

The macro builds the TOC based on text formatted with char style MyStyle. Builds the text of the toc and then calculates how this will affect page numbering and then inserts the results at the current location. The macro only collected the text string formatted with this style till it hits a section break which designates the end of the chapter.

So we will have to build two TOC, one for the main text area and another for the FN area, and then manually merge them

I imagine this macro can be modified a lot to do a more efficient job. If anybody does do anything I would appreciate them posting it here.

I didn't write this of course only paid a friend of mine to do it,

Enjoy!

Susan

PS Since I paid for this and this friend takes money for every and any keystroke he makes for me I would appreciate hearing criticism if you think he went about it correctly. Thank you -Susan
-------------------------------------------------------------->

Code:

Sub MakeTOCBasedOnFN()
    CreateTableContentsForCurrentSection "myStyle"
End Sub

Code:

Sub CreateTableContentsForCurrentSection(styleName As String)
        
    Dim curSec As Section
    Set curSec = GetCurrrentSection
    
    Dim texts As New Collection
    
    ScanSectionFootNotes curSec, texts, styleName
    InsertTableOfContents texts

End Sub

Code:

Sub InsertTableOfContents(texts As Collection)

    Dim paras As New Collection
    Dim rng As Range
    Dim i As Integer
    For i = 1 To texts.Count
        Set rng = texts(i)
        Selection.TypeText rng.text
        paras.Add Selection.Range.Duplicate
        Selection.TypeText vbCr
    Next
    
    Dim paraRng As Range
    For i = 1 To paras.Count
        Set rng = texts(i)
        Set paraRng = paras(i)
        paraRng.text = " " & rng.Information(wdActiveEndAdjustedPageNumber)
    Next
    
End Sub

Code:

Sub ScanSectionFootNotes(sec As Section, texts As Collection, styleName As String)

    Dim orginalSelection As Range
    Set orginalSelection = Selection.Range.Duplicate
    
    Dim fn As Footnote
    Dim findRenge As Range
    Dim i As Integer
    For i = 1 To sec.Range.Footnotes.Count
        Set fn = sec.Range.Footnotes(i)
        Set findRenge = fn.Range.Duplicate
        Do
            If Not (findRenge.Style Is Nothing) Then
                If findRenge.Style = ActiveDocument.Styles(styleName) Then
                    texts.Add findRenge.Duplicate
                    Exit Do
                End If
            End If
            With findRenge.Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .Style = styleName
                .text = ""
                .Replacement.text = ""
                .Format = True
                .Forward = True
                .Wrap = wdFindStop
                
                If Not .Execute Then Exit Do
                              
                texts.Add findRenge.Duplicate
                findRenge.Collapse wdCollapseEnd
                findRenge.End = fn.Range.End
                If findRenge.text = "" Then Exit Do
            End With
        Loop
    Next
    
    orginalSelection.Select
    
End Sub=

Code:

Function GetCurrrentSection() As Section

    Dim sec As Section
    For Each sec In ActiveDocument.Sections
        If Selection.Start >= sec.Range.Start And Selection.Start <= sec.Range.End Then
            Set GetCurrrentSection = sec
            Exit Function
        End If
    Next
    
    Err.Raise 111111, , "Current secton not found"
    
End Function

<--------------------------------------------------------

Moved by moderator from separate post. Reformatted to add CODE tags.