How do I apply a style to all cross-references in a document?

172 Views Asked by At

I created a hyperlink style that turns text blue and bold.

I would like to apply the style to the hyperlinks in the document.

When I run the macro the output is "no hyperlinks found."

    Dim objDoc As Document
    Dim objFld As Field

    Set objDoc = ActiveDocument 
    If Selection.Fields.Count >= 1 Then
        For Each objFld In objDoc.Fields 
            If objFld.Type = wdFieldRef Then 
                objFld.ShowCodes = True
                objFld.Select
                Selection.Collapse wdCollapseStart
                Selection.MoveStartUntil "R"
                Selection.Fields(1).Code.Text = Selection.Fields(1).Code.Text & "\*CharFormat"
                Selection.Style = ActiveDocument.Styles("HyperlinkStyle")
                objFld.Update 
                objFld.ShowCodes = True
            End If
        Next objFld
    Else
        MsgBox "No hyperlinks found.", vbInformation, "Select OK"
    End If
End Sub
1

There are 1 best solutions below

3
Timothy Rylatt On

Although your cross references link to other parts of the document they are not treated the same as actual hyperlinks. If they were the default Hyperlink and FollowedHyperlink styles would be applied.

You are seeing that message, the wording of which is misleading, not because there are no hyperlinks in the document, but because there are no fields in the currently selected text. You can avoid this by looking at the document as a whole rather than just the selected text.

Personally, I would rename "HyperlinkStyle" to "Cross Reference Text" to make the purpose of the style clear, unless you intend all hyperlinks to be formatted that way in which case just modify the Hyperlink style and use that.

You can also avoid changing the selection at all by working directly with objFld:

Sub FormatCrossReferences() Dim objDoc As Document Dim objFld As Field

Set objDoc = ActiveDocument
If objDoc.Fields.Count >= 1 Then
    For Each objFld In objDoc.Fields
        With objFld
            If .Type = wdFieldRef Then
                If Not Right(.Code.Text, 13) = "\*CharFormat " Then .Code.Text = .Code.Text & "\*CharFormat "
                .Code.Characters.First.Style = objDoc.Styles("Cross Reference Text")
                .Result.Style = objDoc.Styles("Cross Reference Text")
            End If
        End With
    Next objFld
Else
    MsgBox "No cross references found.", vbInformation, "Select OK"
End If

End Sub