Excel VBA - замена искомого текста в сгенерированной таблице документов Word гиперссылками - PullRequest
Новая
       18

Excel VBA - замена искомого текста в сгенерированной таблице документов Word гиперссылками

0 голосов
/ 31 марта 2020

У меня есть документ 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»: метод «Выполнить» объекта «Найти» не удался ». Указанная ошибка c иногда изменяется, но всегда срабатывает после замены первой цели текстовая строка с скопированной ячейкой. Я думал, что часть проблемы может заключаться в том, что она вставляет всю скопированную ячейку из 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

Эта версия выдает мне «Ошибка времени выполнения» 450: неверное количество аргументов или неправильное присвоение свойства "в строке" With Selection.Find ".

Я пробовал несколько других версий (и их различных комбинаций), в основном пытаясь работать по добавленным ссылкам, но получил аналогичное отсутствие результатов. Надеюсь, что это просто глупость, которую я пропустил - благодарю за любую помощь!

Источник 1 Источник 2 Источник 3 Источник 4

1 Ответ

0 голосов
/ 31 марта 2020

Примеры, которые вы просматривали, относятся к макросам 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
...