0
votes

I really have problems with this one. Imagine I have the word „stackoverflow“. At the end of the document there is a glossary. Now I need a macro that searches for all occurences of stackoverflow and replaces them with a hyperlink to the bookmark in the table. A reader still sees „stackoverflow“ but can click on it to jump to the Glossary. I can insert online links in „address“ field and think I need the subaddress field but do not know what to put there.. Thank you in advance!

Sub Convert_String()
Dim Word
Dim R As Range
Dim Tabellenanzahl
Dim T As Table
Dim Link As Hyperlink

Set R = ActiveDocument.Range
Tabellenanzahl = ActiveDocument.Tables.Count
Set T = ActiveDocument.Tables(Tabellenanzahl)
ActiveDocument.Bookmarks.Add "Anker", T.Range

For Z = 2 To T.Rows.Count
    Set Wort = T.Cell(Z, 1)

        With R.Find
            .ClearFormatting
            .Text = Word
            .Forward = True
            .Wrap = wdFindStop
        End With

    Do While R.Find.Execute
        R.Hyperlinks.Add Anchor:=Selection, SubAddress:="Anker", TextToDisplay:="GoToGlossaryTest"
    Loop

  Next

End Sub
1

1 Answers

0
votes

Try:

Sub GlossaryLinker()
Application.ScreenUpdating = False
Dim Tbl As Table, Rng As Range, HLnk As Hyperlink
Dim strFnd As String, BkMkNm As String, r As Long
With ActiveDocument
  Set Tbl = .Tables(.Tables.Count)
  For r = 2 To Tbl.Rows.Count
    With Tbl.Cell(r, 1)
      Set Rng = .Range
      With Rng
        .End = .End - 1
        strFnd = Trim(Split(.Text, vbCr)(0))
        BkMkNm = Replace(strFnd, " ", "_")
        .Bookmarks.Add BkMkNm, .Duplicate
      End With
    End With
    Set Rng = .Range(.Range.Start, Tbl.Range.Start)
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .Text = strFnd
        .Wrap = wdFindStop
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchCase = True
        .Execute
      End With
      Do While .Find.Found
        If .InRange(Rng) = False Then Exit Do
        Set HLnk = .Hyperlinks.Add(.Duplicate, , BkMkNm, , .Text)
        .End = HLnk.Range.End
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub