L
Leila
Hi there, below codes highlights paragraphs that are styled with a specific
style. when a document has a TOC (table of content) macro will save it as an
Autotext, delete the Autotext and then processes the highlight and then
reinsert the autotext back when the highlight is done.
the problem is when TOC is reinserted Word asks to update the tabel or the
page numbers only and when I select 'ok' or 'cancel' a spare Word opens
without anything in it. I cant even see the menubar or toolbars in it. which
is very anoying.
I dont get this problem in office 2003, just with 2000. Please help!!
many thanks,
leila
--------------------------------
Public Sub Highlight_Annotation()
Const cBMName As String = "TOCPosition"
Dim tocItem As Word.TableOfContents
Dim rngTOC As Word.Range
'On Error GoTo ErrorHandler
With ActiveDocument
If .TablesOfContents.Count > 0 Then
' Use the first TOC in the document
Set tocItem = .TablesOfContents(1)
' Bookmark it, delete it and rebookmark it!
With .Bookmarks
.Add cBMName, tocItem.Range
Set rngTOC = .Item(cBMName).Range
ActiveDocument.AttachedTemplate.AutoTextEntries.Add _
Range:=rngTOC, Name:="TOCField"
rngTOC.Text = vbNullString
.Add cBMName, rngTOC
End With
Highlight
' Reinsert the TOC at the correct location
InsertAutoText "TOCField", cBMName
ActiveDocument.AttachedTemplate.AutoTextEntries("TOCField").Delete
'NormalTemplate.AutoTextEntries("TOCField").Delete
Else
Highlight
End If
End With
'ErrorHandler:
'MsgBox "Error #" & Err.Number & " occurred. " & Err.Description,
vbOKOnly, "Error"
End Sub
------------------------------
Private Sub InsertAutoText(ByVal strAutoTextName As String, _
ByVal strBookmarkName As String)
'This code inserts the AutoText containing the TOC field at the location of
the
'old TOC.
Dim tplAttached As Word.Template
Dim rngLocation As Word.Range
'On Error GoTo ErrorHandler
' Insert specified autotext at the bookmarked location
' and then recreate the bookmark
Set tplAttached = ActiveDocument.AttachedTemplate
Set rngLocation = ActiveDocument.Bookmarks(strBookmarkName).Range
Set rngLocation =
tplAttached.AutoTextEntries(strAutoTextName).Insert(rngLocation, True)
ActiveDocument.Bookmarks.Add strBookmarkName, rngLocation
'ErrorHandler:
'MsgBox "Error #" & Err.Number & " occurred. " & Err.Description,
vbOKOnly, "Error"
End Sub
-----------------------------------------------
Sub Highlight()
Dim i As Integer
Dim AnnParaNo As Integer
AnnParaNo = 0
Dim TOC As Integer
TOC = 0
'On Error GoTo ErrorHandler
'change the cursor to hourglass
System.Cursor = wdCursorWait
For i = 1 To ActiveDocument.Paragraphs.Count
If ActiveDocument.Paragraphs(i).Style = "Commentary,ct" Then
AnnParaNo = AnnParaNo + 1
ActiveDocument.Paragraphs(i).Range.Font.Underline =
wdUnderlineSingle
ActiveDocument.Paragraphs(i).Range.Font.Color = wdColorBlue
End If
' Print the the number of searched paragraphs and annotations in the
status bar
Application.StatusBar = "The number of paragraphs have been searched is
" & i & " and the number of annotations is " & AnnParaNo
Next i
'Set back the status bar
Application.StatusBar = False
MsgBox "There are " & AnnParaNo & " Annotated Paragraphs", vbOKOnly
'At the end of the code set the cursor back
System.Cursor = wdCursorNormal
'ErrorHandler:
'MsgBox "Error #" & Err.Number & " occurred. " & Err.Description,
vbOKOnly, "Error"
End Sub
style. when a document has a TOC (table of content) macro will save it as an
Autotext, delete the Autotext and then processes the highlight and then
reinsert the autotext back when the highlight is done.
the problem is when TOC is reinserted Word asks to update the tabel or the
page numbers only and when I select 'ok' or 'cancel' a spare Word opens
without anything in it. I cant even see the menubar or toolbars in it. which
is very anoying.
I dont get this problem in office 2003, just with 2000. Please help!!
many thanks,
leila
--------------------------------
Public Sub Highlight_Annotation()
Const cBMName As String = "TOCPosition"
Dim tocItem As Word.TableOfContents
Dim rngTOC As Word.Range
'On Error GoTo ErrorHandler
With ActiveDocument
If .TablesOfContents.Count > 0 Then
' Use the first TOC in the document
Set tocItem = .TablesOfContents(1)
' Bookmark it, delete it and rebookmark it!
With .Bookmarks
.Add cBMName, tocItem.Range
Set rngTOC = .Item(cBMName).Range
ActiveDocument.AttachedTemplate.AutoTextEntries.Add _
Range:=rngTOC, Name:="TOCField"
rngTOC.Text = vbNullString
.Add cBMName, rngTOC
End With
Highlight
' Reinsert the TOC at the correct location
InsertAutoText "TOCField", cBMName
ActiveDocument.AttachedTemplate.AutoTextEntries("TOCField").Delete
'NormalTemplate.AutoTextEntries("TOCField").Delete
Else
Highlight
End If
End With
'ErrorHandler:
'MsgBox "Error #" & Err.Number & " occurred. " & Err.Description,
vbOKOnly, "Error"
End Sub
------------------------------
Private Sub InsertAutoText(ByVal strAutoTextName As String, _
ByVal strBookmarkName As String)
'This code inserts the AutoText containing the TOC field at the location of
the
'old TOC.
Dim tplAttached As Word.Template
Dim rngLocation As Word.Range
'On Error GoTo ErrorHandler
' Insert specified autotext at the bookmarked location
' and then recreate the bookmark
Set tplAttached = ActiveDocument.AttachedTemplate
Set rngLocation = ActiveDocument.Bookmarks(strBookmarkName).Range
Set rngLocation =
tplAttached.AutoTextEntries(strAutoTextName).Insert(rngLocation, True)
ActiveDocument.Bookmarks.Add strBookmarkName, rngLocation
'ErrorHandler:
'MsgBox "Error #" & Err.Number & " occurred. " & Err.Description,
vbOKOnly, "Error"
End Sub
-----------------------------------------------
Sub Highlight()
Dim i As Integer
Dim AnnParaNo As Integer
AnnParaNo = 0
Dim TOC As Integer
TOC = 0
'On Error GoTo ErrorHandler
'change the cursor to hourglass
System.Cursor = wdCursorWait
For i = 1 To ActiveDocument.Paragraphs.Count
If ActiveDocument.Paragraphs(i).Style = "Commentary,ct" Then
AnnParaNo = AnnParaNo + 1
ActiveDocument.Paragraphs(i).Range.Font.Underline =
wdUnderlineSingle
ActiveDocument.Paragraphs(i).Range.Font.Color = wdColorBlue
End If
' Print the the number of searched paragraphs and annotations in the
status bar
Application.StatusBar = "The number of paragraphs have been searched is
" & i & " and the number of annotations is " & AnnParaNo
Next i
'Set back the status bar
Application.StatusBar = False
MsgBox "There are " & AnnParaNo & " Annotated Paragraphs", vbOKOnly
'At the end of the code set the cursor back
System.Cursor = wdCursorNormal
'ErrorHandler:
'MsgBox "Error #" & Err.Number & " occurred. " & Err.Description,
vbOKOnly, "Error"
End Sub