Microsoft Office Forums - View Single Post

KoolBreeze · 11-25-2024, 09:57 PM

The modified version of Guessed's code below works as intended. Instead of trying to delete the top entry in the TOC, I changed the formatting to make it invisible. There may be a better way of doing it, but this seems to work very well.

Thanks guys for all of the help!

Code:

Sub TOC_Fiddler()
  Dim aPar As Paragraph, aTOC As TableOfContents, i As Integer, aRng As Range, lngNumTOC As Long
  
  lngNumTOC = ActiveDocument.TablesOfContents.Count
  For Each TOC In ActiveDocument.TablesOfContents
    
    Set aTOC = ActiveDocument.TablesOfContents(lngNumTOC)
    aTOC.Update
    
    Set aRng = aTOC.Range
    For i = aRng.Paragraphs.Count - 1 To 1 Step -1
         If aRng.Paragraphs(i).Style = "TOC 1" And aRng.Paragraphs(i).Next.Style = "TOC 1" Then
            If i > 1 Then
                aRng.Paragraphs(i).Range.Delete
            Else
                aRng.Paragraphs(i).SpaceAfter = 0
                aRng.Paragraphs(i).SpaceBefore = 0
                aRng.Paragraphs(i).Range.Font.Size = 1
                aRng.Paragraphs(i).Range.Font.ColorIndex = wdWhite
            End If
        End If
    Next i
    
    lngNumTOC = lngNumTOC - 1
  Next

End Sub