Update TOC Macro - MS Word 2000

[izzyq]

I've recorded a macro to update the Table of contents in my document, but when I run the macro it duplicates the headings. The document is somewhat complicated in that it is an access report that is saved as RIch Text Format and inserted into the word document. There is macro in word that is used to clear all page breaks and another that formats all the main topics as "heading 1". Here is the code to update the TOC as well as the code at formats the headings:

I'm not really sure the reasoning behind it duplicating the Table of contents though.


Sub Update_TOC()
'
'
Selection.GoTo What:=wdGoToBookmark, Name:="Table_Of_Contents"
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 1&quot
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Fields.Update
End Sub



Sub Heading_1()
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("Heading 1&quot
With Selection.Find
.Text = "#*#*"
.Replacement.Text = "^m"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 1&quot
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("Heading 1&quot
With Selection.Find.Replacement.Font
.Bold = True
.Italic = True
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub Help Me Obi Wan Kenobi, You're My Only Hope.

 

[asjeff]

try something like:

Dim tocs As TableOfContents

For Each tocs In ActiveDocument.TablesOfContents
'update the TOC
tocs.Update
Next tocs


Asjeff