Word页脚中的超链接文本到选定的书签

时间:2014-05-19 06:50:38

标签: vba hyperlink footer word-vba

我希望在我的所有文档中都有一个自定义页脚,其中包含指向同一文档中书签的超链接文本。即文件顶部'所有页脚中的链接。我必须收集所有地方的信息才能实现这一目标。并希望在这里分享,以便其他人不必同时为这件事做斗争。

到目前为止所有的问题&来自stackoverflow和其他网站的建议,我已经实现了这么多 -

  • 创建一个宏来自动创建文档中所选文本的书签。
  • 书签将重新创建(删除并创建)(如果已存在)
  • 宏将添加一个带页码的新页脚和带分隔符的文本(即/命中概述)。

现在我想在页脚中创建一个HyperLink到书签。代码很简单。但我想我做错了什么,尝试创建一个HyperLink对象。但没有工作。请提出建议。

这是宏功能 -

        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

1 个答案:

答案 0 :(得分:0)

好吧,它不是Macro的问题(下面除外),它是我测试的几个文件的问题。 我错过的几个错误 - SubAddress:=" BOOKMARK_NAME " AND Anchor:= 选择 .Range。

如果任何Doc已经在页脚中有一些文本,则会出现问题。所以现在我先删除页脚。

以下是每个人的参考代码 -

    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