Excel VBA - 用超链接替换生成的 Word 文档表中的搜索文本

Question

我有一个 Excel 文档，它使用 VBA 从中央数据集生成 100 多个季度报告。 数据透视表从 Excel 文档中复制并粘贴到用作报告模板的 Word 文档中。

表中的一列包含文本，我希望将这些文本放入与行数据源相关的相关页面的格式化超链接中。 我找不到允许超链接从查找表转换到数据透视表的方法（数据透视表简单地返回显示文本，没有链接）。

我的想法是编写一个脚本来搜索表格中的文本字符串，并简单地将其替换为格式化的链接。 不幸的是，尽管尝试了多个版本，但我还是无法使这种方法发挥作用。

我对 VBA 还很陌生，所以可能会遗漏一些简单的东西，但我现在已经很好了。 这是我迄今为止尝试过的：

第一个版本尝试从 Excel 文档中的指定单元格复制格式化的超链接，然后将搜索文本替换为“^c”

ThisWorkbook.Worksheets("SheetA").Range("A1").Copy

With myDoc.Content.Find
     .Execute findText:="target text string", ReplaceWith:="^c", Replace:=wdReplaceAll
End With

此版本因“运行时错误'6015'：对象'Find'的方法'执行'失败”而崩溃，具体错误有时会有所不同，但总是在用复制的单元格替换第一个目标文本字符串后触发。 我认为问题的一部分可能是它将从 Excel 复制的整个单元格粘贴到 Word 表格的单元格中（不仅仅是超链接），但我找不到只粘贴链接的方法。

第二个版本尝试直接编码搜索和链接

Dim h, urlString, displayText as String
h = "target text string"
urlString = "desired address"
displayText = "hyperlink display text"

myDoc.Content.Select

With Selection.Find
     .ClearFormatting
     .Text = h
     .Forward = True
     .Wrap = wdFindContinue
End With

Do While Selection.Find.Execute
     Selection.Text = "h"
     ActiveDocument.Hyperlinks.Add Selection.Range, _
          Address:=urlString, SubAddress:="", _
          TextToDisplay:=displayText
Loop

此版本在“With Selection.Find”行上给我一个“运行时错误‘450’：参数数量错误或属性分配无效”。

我尝试了一些其他版本（以及它们的各种组合），主要是尝试从附加的链接中工作，但也遇到了类似的缺乏结果。 希望这只是我错过的一些愚蠢的事情 - 感谢任何帮助！

来源 1 来源 2 来源 3 来源 4

Answer 1

您查看的示例适用于 vbscript 或 Word 宏。 有关 Excel 宏的信息，请参阅此处或此处。

Sub update_links()

    Const WORD_DOC = "C:\tmp\test.docx"
    Const TARGET = "target text string"
    Const URL = "desired address"
    Const HYPERLINK = "hyperlink display text"

    Dim apWord As Variant, wdDoc As Document, count As Integer
    Set apWord = New Word.Application
    apWord.Visible = True

    Set wdDoc = apWord.Documents.Open(WORD_DOC)
    wdDoc.Activate

    count = 0
    With wdDoc.Range
        With .Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .MatchWildcards = True
            .Text = TARGET
            .Replacement.Text = ""
            .Execute
        End With

        Do While .Find.Found = True

            With .Find
                apWord.ActiveDocument.Hyperlinks.Add _
                    Anchor:=.Parent, Address:=URL, _
                    TextToDisplay:=HYPERLINK

                count = count + 1
            End With
            .Collapse wdCollapseEnd
            .Find.Execute

        Loop
    End With
    wdDoc.SaveAs "c:\tmp\test_updated.docx"
    wdDoc.Close
    apWord.Quit
    Set apWord = Nothing

    MsgBox count & " links added to " & WORD_DOC, vbInformation

End Sub