使指向本文档中地点的链接在 vba 中有效
Making links to Places in this document work in vba
我正在尝试制作一个 VBA 脚本,它将获取文档中的所有标题并从中制作出 table 内容,使用 hyperlinks每个标题。所有标题都已找到、解析并生成了所有 hyperlink,但是它们没有正确到达其目的地,即文档中的某个位置。默认 'create hyperlink to Place in this document' 代码如下所示:
Selection.Range.Hyperlinks(1).Range.Fields(1).Result.Select
Selection.Range.Hyperlinks(1).Delete
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
SubAddress:="_Test_Heading"
Selection.Collapse Direction:=wdCollapseEnd
如果您在使用 'Edit hyperlink' window.
时录制宏,您将获得此代码
Edit hyperlink window
通常有URL的地址字段为空,而子地址字段由header的名称和下划线填充。
我认为问题在于 Word 默认为 'Existing file or web page' 而不是 'Place in this document',即使之前指定了 'Place in this document'。如果我在不更改子地址或其他任何内容的情况下将 link 的模式切换为 'Place in this document',它会起作用 - 但必须为每个 link 执行此操作会破坏脚本的目的。我一直在寻找一种在 VBA 中表达 'Place in this document' 的方法,但没有找到任何东西。尝试使用书签作为替代方法,但也没有用。任何帮助将不胜感激。
我找到了使用 cross-referencing 的解决方法。以防以后对任何人有帮助:
Private Function GetLevel(strItem As String) As Integer
Dim strTemp As String
Dim strOriginal As String
Dim longDiff As Integer
strOriginal = RTrim$(strItem)
strTemp = LTrim$(strOriginal)
longDiff = Len(strOriginal) - Len(strTemp)
GetLevel = (longDiff / 2) + 1
End Function
Sub TableofContents()
Dim i As Integer
Dim AllHeadings As Variant
AllHeadings = ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)
Selection.HomeKey Unit:=wdStory
Selection.HomeKey Unit:=wdLine
For i = LBound(AllHeadings) To UBound(AllHeadings)
strtext = Trim$(AllHeadings(i))
Level = GetLevel(CStr(AllHeadings(i)))
If Level = 2 Then
Selection.InsertCrossReference ReferenceType:="Heading", ReferenceKind:= _
wdContentText, ReferenceItem:=i, InsertAsHyperlink:=True, _
IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
Selection.TypeParagraph
End If
Next
End sub
第一个函数获取标题的级别。
第二部分移动到文档的顶部并开始插入 cross-references 到我想要的标题(在本例中我希望它是 = 2)。
我正在尝试制作一个 VBA 脚本,它将获取文档中的所有标题并从中制作出 table 内容,使用 hyperlinks每个标题。所有标题都已找到、解析并生成了所有 hyperlink,但是它们没有正确到达其目的地,即文档中的某个位置。默认 'create hyperlink to Place in this document' 代码如下所示:
Selection.Range.Hyperlinks(1).Range.Fields(1).Result.Select
Selection.Range.Hyperlinks(1).Delete
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
SubAddress:="_Test_Heading"
Selection.Collapse Direction:=wdCollapseEnd
如果您在使用 'Edit hyperlink' window.
时录制宏,您将获得此代码Edit hyperlink window
通常有URL的地址字段为空,而子地址字段由header的名称和下划线填充。
我认为问题在于 Word 默认为 'Existing file or web page' 而不是 'Place in this document',即使之前指定了 'Place in this document'。如果我在不更改子地址或其他任何内容的情况下将 link 的模式切换为 'Place in this document',它会起作用 - 但必须为每个 link 执行此操作会破坏脚本的目的。我一直在寻找一种在 VBA 中表达 'Place in this document' 的方法,但没有找到任何东西。尝试使用书签作为替代方法,但也没有用。任何帮助将不胜感激。
我找到了使用 cross-referencing 的解决方法。以防以后对任何人有帮助:
Private Function GetLevel(strItem As String) As Integer
Dim strTemp As String
Dim strOriginal As String
Dim longDiff As Integer
strOriginal = RTrim$(strItem)
strTemp = LTrim$(strOriginal)
longDiff = Len(strOriginal) - Len(strTemp)
GetLevel = (longDiff / 2) + 1
End Function
Sub TableofContents()
Dim i As Integer
Dim AllHeadings As Variant
AllHeadings = ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)
Selection.HomeKey Unit:=wdStory
Selection.HomeKey Unit:=wdLine
For i = LBound(AllHeadings) To UBound(AllHeadings)
strtext = Trim$(AllHeadings(i))
Level = GetLevel(CStr(AllHeadings(i)))
If Level = 2 Then
Selection.InsertCrossReference ReferenceType:="Heading", ReferenceKind:= _
wdContentText, ReferenceItem:=i, InsertAsHyperlink:=True, _
IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
Selection.TypeParagraph
End If
Next
End sub
第一个函数获取标题的级别。
第二部分移动到文档的顶部并开始插入 cross-references 到我想要的标题(在本例中我希望它是 = 2)。