excel - 将 Word 文档中的超链接链接到 Excel 工作表中的相应文档

Question

为简单起见，我为客户提供了数百个 word 文档，其中列出了用于这些客户的模板。我需要将每个文档中提到的每个模板超链接到其相应的模板文档，这些模板文档都存储在模板文件夹中。

我有一个 2 列的 excel 电子表格。第一个是模板的名称，第二个是相关文件夹中该模板的超链接。下面是我创建的脚本，但我在获取文本超链接时遇到问题，我尝试了这里编写的代码，并进行了一些更改以搜索和替换我的变量，但它使它们都成为相同的超链接。https://superuser.com/a/1010293

根据我目前对 VBA 的了解，我正在努力寻找另一种方法来做到这一点。

下面是我当前执行整个任务的代码。

    Public strArray() As String
    Public LinkArray() As String
    Public TotalRows As Long

Sub Hyperlink()
Dim file
Dim path As String
Dim FilenameWaterMark As String

Call OpenExcelFile

i = 1
For i = 1 To TotalRows

'here I need the document to look through while searching for strarray(I) 
'and make that string a hyperlink to linkarray(I) 
Next


ActiveDocument.Save

End Sub

Sub OpenExcelFile()
'Variables

    Dim i, x As Long
    Dim oExcel As Excel.Application
    Dim oWB As Workbook
     i = 1
'Opening Excel Sheet
    Set oExcel = New Excel.Application
    Set oWB = oExcel.Workbooks.Open("H:\DCTEST\Templates\DOCS.xlsx")
    oExcel.Visible = True

'Counts Number of Rows in Sheet
    TotalRows = Rows(Rows.Count).End(xlUp).Row
    ReDim strArray(1 To TotalRows)
    ReDim LinkArray(1 To TotalRows)

'Assigns each cell in Column A to an Array
    For i = 1 To TotalRows
        strArray(i) = Cells(i, 1).Value
    Next

'searches for hyperlink
    For i = 1 To TotalRows
        LinkArray(i) = Cells(i, 2).Value
    Next

oExcel.Quit

End Sub

标签： excelvbams-word

Answer 1

我自己弄好了。下面是完整的代码。

Dim strArray() As String
    Dim LinkArray() As String
    Dim TotalRows As Long

Private Sub DOCUMENT_OPEN()
Dim file
Dim path As String
Dim FilenameWaterMark As String
Dim Rng As Range
Dim SearchString As String
Dim EndString As String
Dim Id As String
Dim Link As String

Call OpenExcelFile

i = 1
For i = 1 To TotalRows


Set Rng = ActiveDocument.Range
SearchString = strArray(i)
    With Rng.Find
    .MatchWildcards = False
        Do While .Execute(findText:=SearchString, Forward:=False, MatchWholeWord:=True) = True
            Rng.MoveStartUntil (strArray(i))
            Rng.MoveEndUntil ("")
            Link = LinkArray(i)

                ActiveDocument.Hyperlinks.Add Anchor:=Rng, _
                Address:=Link, _
                SubAddress:="", ScreenTip:="", TextToDisplay:=Rng.Text
                Rng.Collapse wdCollapseStart


        Loop
    End With
Next


ActiveDocument.Save

End Sub

Sub OpenExcelFile()
'Variables

    Dim i, x As Long
    Dim oExcel As Excel.Application
    Dim oWB As Workbook
     i = 1
'Opening Excel Sheet
    Set oExcel = New Excel.Application
    Set oWB = oExcel.Workbooks.Open("H:\DCTEST\Templates\DOCS.xlsx")
    oExcel.Visible = False

'Counts Number of Rows in Sheet
    TotalRows = Rows(Rows.Count).End(xlUp).Row
    ReDim strArray(1 To TotalRows)
    ReDim LinkArray(1 To TotalRows)

'Assigns each cell in Column A to an Array
    For i = 1 To TotalRows
        strArray(i) = Cells(i, 1).Value
    Next

'searches for hyperlink
    For i = 1 To TotalRows
        LinkArray(i) = Cells(i, 2).Value
    Next

oExcel.Quit

End Sub

这在文档打开时运行，并将模板的所有提及链接到模板文件夹中的文档。