Hyperlinked text in Word footers to a selected bookmark

Question

I wanted a custom footer in all my documents with a hyperlinked text to a bookmark in same document. i.e. 'Top Of Document' kind of link in all the footers. I had to collect information for all over the places to achieve this much. and wanted to share here so others do not have to fight for this thing all at once.

So far from all the question & suggestions from stackoverflow and other sites, I have achieved this much-

• Created a macro to create a bookmark automatically, of a selected text in document.
• Bookmark will be re-created (delete and create) if its already present
• Macro will add a new footer with page number and a text with delimiter (i.e. / Hit Overview).

Now I want to create this text in footer a HyperLink to the bookmark. code is simple. but i guess i am doing something wrong, tried by creating a HyperLink object. but not working. please suggest something.

Here is the macro function-

        Sub InsertFootnote()
        Const wdAlignPageNumberCenter = 1
        Dim varNumberPages As Variant
        varNumberPages = ActiveDocument.Content.Information(wdActiveEndAdjustedPageNumber)

        ' Delete bookmark if any with this name
        If ActiveDocument.Bookmarks.Exists("HitOverviewMac") = True Then
            ActiveDocument.Bookmarks("HitOverviewMac").Delete
        End If

        ' Create a Bookmark to the selected text
        With ActiveDocument.Bookmarks
            .Add Range:=Selection.Range, Name:="HitOverviewMac"
            .DefaultSorting = wdSortByName
            .ShowHidden = False
        End With
        Dim mHlink As Hyperlink
        Dim i As Long
        For i = 1 To ActiveDocument.Sections.Count
            With ActiveDocument.Sections(i)
                ' Remove footer
                '.Footers(wdHeaderFooterPrimary).Range.Text = ""
                '.Footers(wdHeaderFooterPrimary).PageNumbers.Add (wdAlignPageNumberCenter)
                '.Footers(wdHeaderFooterPrimary).Range.InsertBefore "Hit Overview / Page "
                .Footers(wdHeaderFooterPrimary).Range.Select
                With Selection
                    If ActiveDocument.Bookmarks.Exists("HitOverviewMac") = True Then
                        .Paragraphs(1).Alignment = wdAlignParagraphCenter
                        .TypeText Text:="Page "
                        .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
                            "PAGE ", PreserveFormatting:=True
                        .TypeText Text:=" of "
                        .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
                            "NUMPAGES ", PreserveFormatting:=True
                        .EndKey Unit:=wdLine
                        .TypeText Text:=" ~ "
                        ActiveDocument.Hyperlinks.Add Anchor:=.Range, Address:="", _
                        SubAddress:="HitOverview", ScreenTip:="", TextToDisplay:="Hit Overview"
                    Else
                        MsgBox "Bookmark does not exists"
                    End If
                End With
            End With
        Next

        End Sub

Answer 1

Ok, Its wasn't the problem with Macro(except below), its the problem with couple of Documents I was testing with. few mistakes that I missed - SubAddress:="BOOKMARK_NAME" AND Anchor:=Selection.Range.

So the problem occurs if any Doc already has some text in footers. and so that now I am removing footer first.

Here is the Code for everyone's reference-

    Sub InsertFootnote()
    Const wdAlignPageNumberCenter = 1
    Dim varNumberPages As Variant
    varNumberPages = ActiveDocument.Content.Information(wdActiveEndAdjustedPageNumber)
    If ActiveDocument.Bookmarks.Exists("HitOverviewMac") = True Then
        ActiveDocument.Bookmarks("HitOverviewMac").Delete
    End If
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="HitOverviewMac"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    Dim mHlink As Hyperlink
    Dim i As Long
    For i = 1 To ActiveDocument.Sections.Count
        With ActiveDocument.Sections(i)
            .Footers(wdHeaderFooterPrimary).Range.Text = ""
            .Footers(wdHeaderFooterPrimary).PageNumbers.Add (wdAlignPageNumberCenter)
            .Footers(wdHeaderFooterPrimary).Range.Select
            With Selection
                If ActiveDocument.Bookmarks.Exists("HitOverviewMac") = True Then
                    .Paragraphs.Alignment = wdAlignParagraphCenter
                    .TypeText Text:="Page "
                    .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
                        "PAGE ", PreserveFormatting:=True
                    .TypeText Text:=" of "
                    .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
                        "NUMPAGES ", PreserveFormatting:=True
                    .EndKey Unit:=wdLine
                    .TypeText Text:=" / "
                    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
                    SubAddress:="HitOverviewMac", ScreenTip:="", TextToDisplay:="Hit Overview"
                Else
                    MsgBox "Bookmark does not exists"
                End If
            End With
        End With
    Next

    End Sub