Связывание гиперссылок в документе Word с соответствующим документом на листе Excel - PullRequest
0 голосов
/ 07 ноября 2018

Для простоты у меня есть несколько сотен документов для клиентов, в которых перечислены шаблоны, используемые для этих клиентов. Мне нужно сделать гиперссылку на каждое упоминание шаблона в каждом документе на соответствующий шаблон документа, которые все хранятся в папке шаблонов.

У меня есть таблица Excel с 2 столбцами. Первый - имя шаблона, второй - гиперссылка на этот шаблон в папке шаблонов. Ниже приведен сценарий, который я создал, но у меня возникают проблемы с получением его для гиперссылки на текст. Я пробовал код, написанный здесь, с некоторыми изменениями для поиска и замены моей переменной, но он делает их все той же гиперссылкой. 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

1 Ответ

0 голосов
/ 07 ноября 2018

Я получил это работает сам. Ниже приведен полный код.

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

Он запускается, когда документ открыт, и связывает все упоминания шаблона с его документом в папке шаблонов.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...