0
votes

I have an Excel document that uses VBA to generate 100+ quarterly reports from a central dataset. Pivot tables are copied from the Excel document and pasted into a Word document that serves as a template for the report.

One of the columns in the tables contains text that I would like to make into formatted hyperlinks to relevant pages related to the row data sources. I was unable to find a method for allowing the hyperlink to survive translation from the lookup table into the pivot table (the pivot table simple returns the display text, without the link).

My thought was to write a script that would search for the text string in the table and simply replace it with the formatted link. Unfortunately, I haven't been able to get this approach to work, despite trying several versions.

I'm fairly new to VBA, so may be missing something simple, but I'm stuck pretty good now. Here's what I've tried so far:

First Version Tried to copy the formatted hyperlink from a designated cell in the Excel document and then Replace the search text with "^c"

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

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

This version crashed with "Run-time error '6015': Method 'Execute' of object 'Find' failed" The specific error sometimes varies, but always triggers after replacing the first target text string with the copied cell. I thought that part of the issue might be that it was pasting the entire copied cell from Excel into the cell of the Word table (not just the hyperlink), but I couldn't find a way to paste just the link.

Second Version Tried to directly code the search and link

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

This version gives me a "Run-time error '450': Wrong number of arguments or invalid property assignment" on the 'With Selection.Find' line.

I've tried a few other versions (and various combinations thereof) mostly trying to work from the appended links, but have gotten a similar lack of results. Hoping it's just something silly I've missed - appreciate any assistance!

Source 1 Source 2 Source 3 Source 4

1
This worked - many thanks!AngryMarvin

1 Answers

0
votes

The examples you looked at are either for vbscript or Word macros. See here or here for Excel macro.

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