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

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

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

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

1 个答案: