M
majorfifth
I've been meaning to post this macro for at least a couple of years,
but never got around to it. The macro addresses the age-old deficiency
in MSWord where entries in a generated index are not hyperlinked to
their destinations. This macro creates hyperlinks between the index
entries and the XE fields that were used to create them.
See what you think. If you have problems with this macro, email me but
be sure to cc this list.
' ===============================================
' Declarations for index link fixing. Place in declarations section.
Public Type XEFieldReference
myFieldName As String
myBookmarkName As String
End Type
Public XEFieldReferences() As XEFieldReference
Public XEFieldReferencesCount As Variant
' ================================================
Sub FixIndexHyperlinks()
'
' FixIndexHyperlinks Macro
' Macro created Oct. 8, 2004 by Colin Ferguson (e-mail address removed)
'
' Feel free to use or distribute as you like. E-mail me if you like it.
' However, by using this code you agree not to sue me if it doesn't
work
' for you or if it screws up some important document.
'
' Note the following:
'
' o The macro only supports two index levels. You can probably modify
it to
' support more levels with very little trouble, however.
' o The macro assumes that you are using the following styles for the
index entries:
' Index 1, Index 2
' o The macro reformats your index as it runs. If you want to change
the way
' the macro formats the index, modify the IndexFieldCodeValue
variable below.
'
' ****CHANGEABLE VALUES*******************************************
' Set EntryToPageNumbersSeparator to the characters you would like to
have appear
' between the index entry and the page references. Equivalent to the \e
switch
' for the INDEX field code, except that it is not limited to five
characters.
EntryToPageNumbersSeparator = " "
' Set PageNumbersSeparator to the characters you would like to have
appear
' between multiple page references. Equivalent to the \l switch for the
' INDEX field code, except that it is not limited to five characters.
PageNumbersSeparator = ", "
' Set IndexFieldCodeValue to the INDEX field code value that you would
like to use
' in your document. Make sure, however, to leave the \e switch value as
shown.
' You can set this value using the EntryToPageNumbersSeparator
variable. Note that
' not all switches are supported by the macro.
IndexFieldCodeValue = "INDEX \e ""!!!"" \h ""A"" \c ""2"" \z
""1033"" \* MERGEFORMAT"
'******************************************************************
' First set display options so page numbers are correct.
Application.DisplayStatusBar = True
With ActiveWindow.View
.ShowFieldCodes = False
.ShowBookmarks = False
.ShowTabs = False
.ShowSpaces = False
.ShowParagraphs = False
.ShowHyphens = False
.ShowHiddenText = False
.ShowAll = False
.ShowDrawings = True
End With
' Find all XE fields in the document. Create a bookmark for each
field, and store the
' index entry text along with the name of the bookmark.
XEFieldReferencesCount = 0
For Each myField In ActiveDocument.Fields
If myField.Type = wdFieldIndexEntry Then ' Field is index entry
field.
' Separate out index entry text
myFieldContents = myField.Code
If InStr(1, myFieldContents, "."" \t""") = 0 Then
myFieldContents = Right(myFieldContents,
Len(myFieldContents) - 5)
myFieldContents = Left(myFieldContents, InStr(1,
myFieldContents, """") - 1)
' Create new array entry.
XEFieldReferencesCount = XEFieldReferencesCount + 1
XEBookmarkName = "XEField" & XEFieldReferencesCount
' Create a bookmark for the field.
myField.Select
ActiveDocument.Bookmarks.Add Name:=XEBookmarkName,
Range:=Selection.Range
ReDim Preserve
XEFieldReferences(XEFieldReferencesCount)
' Store the index entry text.
XEFieldReferences(XEFieldReferencesCount).myFieldName =
Trim(myFieldContents)
' Store the bookmark name.
XEFieldReferences(XEFieldReferencesCount).myBookmarkName =
XEBookmarkName
End If
End If
Next
' Convert the content of the existing index field to text.
ActiveDocument.Indexes(1).Range.Select
Set newRange = Selection.Range
Selection.Fields(1).Code.Text = IndexFieldCodeValue
Selection.Fields(1).Update
Selection.Fields(1).Unlink
' Examine each paragraph in the index.
For Each myIndexParagraph In newRange.Paragraphs
' Check that the paragraph is not an index heading or something
else.
If myIndexParagraph.Style = "Index 1" Or myIndexParagraph.Style
= "Index 2" Then
SeePos = InStr(1, LCase(myIndexParagraph.Range.Text),
"!!!see")
If SeePos = 0 Then ' Regular index entry. Process
accordingly.
' First delete the special separator text inserted by
the macro, and all
' subsequent text in the paragraph.
SplitPos = InStr(1, myIndexParagraph.Range.Text, "!!!")
- 1
If SplitPos > 0 Then ' Index entry has page number.
Process it
Set aRange = myIndexParagraph.Range
aRange.SetRange Start:=myIndexParagraph.Range.Start
+ SplitPos, _
End:=myIndexParagraph.Range.End
aRange.MoveEnd Unit:=wdCharacter, Count:=-1
aRange.Select
Selection.Delete
' Find the end of the text in the paragraph.
Set aRange = myIndexParagraph.Range
aRange.MoveEnd Unit:=wdCharacter, Count:=-1
InputText = Trim(aRange.Text)
' Insert the entry-to-page number separator.
Selection.TypeText
Text:=EntryToPageNumbersSeparator
' If the first level index entry, search on its
text and
' store the text. Its second level index entry,
search on
' its text with the stored text as a prefix.
Select Case myIndexParagraph.Style
Case "Index 1"
Call ProcessIndexEntry(InputText,
PageNumbersSeparator)
Level1Reference = InputText
Case "Index 2"
InputText = Level1Reference & ":" &
InputText
Call ProcessIndexEntry(InputText,
PageNumbersSeparator)
End Select
Else ' Index entry does not have a page number. Simply
store the value
Set aRange = myIndexParagraph.Range
aRange.MoveEnd Unit:=wdCharacter, Count:=-1
InputText = Trim(aRange.Text)
' If the first level index entry, store the text.
' If second level index entry, there's a problem,
but just accept it.
Select Case myIndexParagraph.Style
Case "Index 1"
Level1Reference = InputText
Case "Index 2"
InputText = Level1Reference & ":" &
InputText
End Select
End If
Else ' This is a "See" or "See also" entry. Replace
entry-to-page number
' separator and do nothing else.
Set aRange = myIndexParagraph.Range
aRange.SetRange Start:=myIndexParagraph.Range.Start +
SeePos - 1, _
End:=myIndexParagraph.Range.Start + SeePos + 2
aRange.Select
Selection.Delete
Selection.TypeText Text:=EntryToPageNumbersSeparator
End If
End If
Next
End Sub
' ===============================================================
Sub ProcessIndexEntry(InputText As Variant, PageNumbersSeparator As
Variant)
' Called by the FixIndexHyperlinks macro
' Macro created Oct. 8, 2004 by Colin Ferguson (e-mail address removed)
' Look up the paragraph text in the array of XE field values stored
earlier.
' Whenever a match is found, insert a cross-reference to the XE field
into
' the index.
InsertSeparatorFlag = False
For myEntryCount = 1 To XEFieldReferencesCount
If XEFieldReferences(myEntryCount).myFieldName = InputText Then
If InsertSeparatorFlag = True Then
Selection.TypeText (PageNumbersSeparator)
End If
Selection.InsertCrossReference ReferenceType:="Bookmark",
ReferenceKind:= _
wdPageNumber,
ReferenceItem:=XEFieldReferences(myEntryCount).myBookmarkName, _
InsertAsHyperlink:=True, IncludePosition:=False
InsertSeparatorFlag = True
End If
Next
End Sub
' End of FixIndexHyperlinks macro code
but never got around to it. The macro addresses the age-old deficiency
in MSWord where entries in a generated index are not hyperlinked to
their destinations. This macro creates hyperlinks between the index
entries and the XE fields that were used to create them.
See what you think. If you have problems with this macro, email me but
be sure to cc this list.
' ===============================================
' Declarations for index link fixing. Place in declarations section.
Public Type XEFieldReference
myFieldName As String
myBookmarkName As String
End Type
Public XEFieldReferences() As XEFieldReference
Public XEFieldReferencesCount As Variant
' ================================================
Sub FixIndexHyperlinks()
'
' FixIndexHyperlinks Macro
' Macro created Oct. 8, 2004 by Colin Ferguson (e-mail address removed)
'
' Feel free to use or distribute as you like. E-mail me if you like it.
' However, by using this code you agree not to sue me if it doesn't
work
' for you or if it screws up some important document.
'
' Note the following:
'
' o The macro only supports two index levels. You can probably modify
it to
' support more levels with very little trouble, however.
' o The macro assumes that you are using the following styles for the
index entries:
' Index 1, Index 2
' o The macro reformats your index as it runs. If you want to change
the way
' the macro formats the index, modify the IndexFieldCodeValue
variable below.
'
' ****CHANGEABLE VALUES*******************************************
' Set EntryToPageNumbersSeparator to the characters you would like to
have appear
' between the index entry and the page references. Equivalent to the \e
switch
' for the INDEX field code, except that it is not limited to five
characters.
EntryToPageNumbersSeparator = " "
' Set PageNumbersSeparator to the characters you would like to have
appear
' between multiple page references. Equivalent to the \l switch for the
' INDEX field code, except that it is not limited to five characters.
PageNumbersSeparator = ", "
' Set IndexFieldCodeValue to the INDEX field code value that you would
like to use
' in your document. Make sure, however, to leave the \e switch value as
shown.
' You can set this value using the EntryToPageNumbersSeparator
variable. Note that
' not all switches are supported by the macro.
IndexFieldCodeValue = "INDEX \e ""!!!"" \h ""A"" \c ""2"" \z
""1033"" \* MERGEFORMAT"
'******************************************************************
' First set display options so page numbers are correct.
Application.DisplayStatusBar = True
With ActiveWindow.View
.ShowFieldCodes = False
.ShowBookmarks = False
.ShowTabs = False
.ShowSpaces = False
.ShowParagraphs = False
.ShowHyphens = False
.ShowHiddenText = False
.ShowAll = False
.ShowDrawings = True
End With
' Find all XE fields in the document. Create a bookmark for each
field, and store the
' index entry text along with the name of the bookmark.
XEFieldReferencesCount = 0
For Each myField In ActiveDocument.Fields
If myField.Type = wdFieldIndexEntry Then ' Field is index entry
field.
' Separate out index entry text
myFieldContents = myField.Code
If InStr(1, myFieldContents, "."" \t""") = 0 Then
myFieldContents = Right(myFieldContents,
Len(myFieldContents) - 5)
myFieldContents = Left(myFieldContents, InStr(1,
myFieldContents, """") - 1)
' Create new array entry.
XEFieldReferencesCount = XEFieldReferencesCount + 1
XEBookmarkName = "XEField" & XEFieldReferencesCount
' Create a bookmark for the field.
myField.Select
ActiveDocument.Bookmarks.Add Name:=XEBookmarkName,
Range:=Selection.Range
ReDim Preserve
XEFieldReferences(XEFieldReferencesCount)
' Store the index entry text.
XEFieldReferences(XEFieldReferencesCount).myFieldName =
Trim(myFieldContents)
' Store the bookmark name.
XEFieldReferences(XEFieldReferencesCount).myBookmarkName =
XEBookmarkName
End If
End If
Next
' Convert the content of the existing index field to text.
ActiveDocument.Indexes(1).Range.Select
Set newRange = Selection.Range
Selection.Fields(1).Code.Text = IndexFieldCodeValue
Selection.Fields(1).Update
Selection.Fields(1).Unlink
' Examine each paragraph in the index.
For Each myIndexParagraph In newRange.Paragraphs
' Check that the paragraph is not an index heading or something
else.
If myIndexParagraph.Style = "Index 1" Or myIndexParagraph.Style
= "Index 2" Then
SeePos = InStr(1, LCase(myIndexParagraph.Range.Text),
"!!!see")
If SeePos = 0 Then ' Regular index entry. Process
accordingly.
' First delete the special separator text inserted by
the macro, and all
' subsequent text in the paragraph.
SplitPos = InStr(1, myIndexParagraph.Range.Text, "!!!")
- 1
If SplitPos > 0 Then ' Index entry has page number.
Process it
Set aRange = myIndexParagraph.Range
aRange.SetRange Start:=myIndexParagraph.Range.Start
+ SplitPos, _
End:=myIndexParagraph.Range.End
aRange.MoveEnd Unit:=wdCharacter, Count:=-1
aRange.Select
Selection.Delete
' Find the end of the text in the paragraph.
Set aRange = myIndexParagraph.Range
aRange.MoveEnd Unit:=wdCharacter, Count:=-1
InputText = Trim(aRange.Text)
' Insert the entry-to-page number separator.
Selection.TypeText
Text:=EntryToPageNumbersSeparator
' If the first level index entry, search on its
text and
' store the text. Its second level index entry,
search on
' its text with the stored text as a prefix.
Select Case myIndexParagraph.Style
Case "Index 1"
Call ProcessIndexEntry(InputText,
PageNumbersSeparator)
Level1Reference = InputText
Case "Index 2"
InputText = Level1Reference & ":" &
InputText
Call ProcessIndexEntry(InputText,
PageNumbersSeparator)
End Select
Else ' Index entry does not have a page number. Simply
store the value
Set aRange = myIndexParagraph.Range
aRange.MoveEnd Unit:=wdCharacter, Count:=-1
InputText = Trim(aRange.Text)
' If the first level index entry, store the text.
' If second level index entry, there's a problem,
but just accept it.
Select Case myIndexParagraph.Style
Case "Index 1"
Level1Reference = InputText
Case "Index 2"
InputText = Level1Reference & ":" &
InputText
End Select
End If
Else ' This is a "See" or "See also" entry. Replace
entry-to-page number
' separator and do nothing else.
Set aRange = myIndexParagraph.Range
aRange.SetRange Start:=myIndexParagraph.Range.Start +
SeePos - 1, _
End:=myIndexParagraph.Range.Start + SeePos + 2
aRange.Select
Selection.Delete
Selection.TypeText Text:=EntryToPageNumbersSeparator
End If
End If
Next
End Sub
' ===============================================================
Sub ProcessIndexEntry(InputText As Variant, PageNumbersSeparator As
Variant)
' Called by the FixIndexHyperlinks macro
' Macro created Oct. 8, 2004 by Colin Ferguson (e-mail address removed)
' Look up the paragraph text in the array of XE field values stored
earlier.
' Whenever a match is found, insert a cross-reference to the XE field
into
' the index.
InsertSeparatorFlag = False
For myEntryCount = 1 To XEFieldReferencesCount
If XEFieldReferences(myEntryCount).myFieldName = InputText Then
If InsertSeparatorFlag = True Then
Selection.TypeText (PageNumbersSeparator)
End If
Selection.InsertCrossReference ReferenceType:="Bookmark",
ReferenceKind:= _
wdPageNumber,
ReferenceItem:=XEFieldReferences(myEntryCount).myBookmarkName, _
InsertAsHyperlink:=True, IncludePosition:=False
InsertSeparatorFlag = True
End If
Next
End Sub
' End of FixIndexHyperlinks macro code