Home > Software engineering >  Automatic hyperlink for specific keywords in blog writing in VBA/Macro
Automatic hyperlink for specific keywords in blog writing in VBA/Macro

Time:12-28

I have found a code that finds a specific keyword and inserts the relative hyperlink which is specified. But the macro seems to only do one keyword at a time and is unable to do multiple. For example, in the code below it the macro will change the last SearchText to the correct hyperlink. Is there any way it could do multiple I'm looking to do this for website blogging so there would actually be over a 100 Keywords and relative hyperlinks? Any would help would be greatly appreciated.

Private Sub HyperlinkText_Click()

Dim SearchRange As Range
Dim SearchText As String
Dim WebAddress As String

Set SearchRange = ActiveDocument.Range
SearchText = "AMD41"
WebAddress = "http://www.example.com/"

SearchText = "AMD42"
WebAddress = "http://www.examples.com/"


With SearchRange.Find
    Do While .Execute(SearchText, , True, , , , True) = True
        With SearchRange
            .Hyperlinks.Add SearchRange, WebAddress
        End With
        SearchRange.Collapse wdCollapseEnd
    Loop
End With
End Sub

I tried just adding more SearchText and WebAddress and thought it might add multiple hyperlinks to the relative keywords.

CodePudding user response:

Potentially very fast, especially where you have multiple instances of the same expression to convert:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, ArrFnd, ArrRep
ArrFnd = Array("AMD41", "AMD42")
ArrRep = Array("http://www.example.com/", "http://www.examples.com/")
With ActiveDocument
  For i = 0 To UBound(ArrFnd)
    .Hyperlinks.Add Anchor:=.Range(0, 0), Address:=ArrRep(i), TextToDisplay:=ArrFnd(i)
    .Hyperlinks(1).Range.Cut
    With .Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Format = False
      .Wrap = wdFindContinue
      .Text = ArrFnd(i)
      .Replacement.Text = "^c"
      .Execute Replace:=wdReplaceAll
    End With
    .UndoClear
  Next
End With
Application.ScreenUpdating = True
End Sub

All you need ensure is that you have the same number of entries for ArrFnd and ArrRep.

  • Related