Results 1 to 3 of 3
  1. #1
    Lounger
    Join Date
    Dec 2011
    Posts
    27
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Replace text in footnotes with hyperlinked text

    Hi guys,

    I've got documents where I need to search through and hyperlink any text which follows a particular formula. This is the code:

    Code:
    Sub AddHyperlinks()
    Application.ScreenUpdating = False
    Dim wdDoc As Document
      Set wdDoc = ActiveDocument
      With wdDoc.Range
        With .Find
          .ClearFormatting
        'This searches for a reference of XXX+.0000.0000.0000 (where XXX+ is equal to at least 3 letters).  If the references are different to this, change the next line of code.
          .Text = "<[A-Z]{3,}.[0-9]{4}.[0-9]{4}.[0-9]{4}"
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindStop
          .Format = False
          .MatchWildcards = True
          .Execute
        End With
        Do While .Find.Found
        'Change the web address here to reflect the web address of the current e-file
          .Hyperlinks.Add Anchor:=.Duplicate, Address:="[insert first part of hyperlink]" & .Text & ".PDF", TextToDisplay:=.Text
          .End = .End + 1
          .Collapse wdCollapseEnd
          .Find.Execute
        Loop
      End With
    Set wdDoc = Nothing
    Application.ScreenUpdating = True
    End Sub
    It works great. However, I now need a similar macro to do the same thing to footnotes. I've got the find and replace code for footnotes:

    Code:
    Dim myStoryRange As Range
    
    For Each myStoryRange In ActiveDocument.StoryRanges
       If myStoryRange.StoryType <> wdMainTextStory Then
            With myStoryRange.Find
                .Text = "<[A-Z]{3,}.[0-9]{4}.[0-9]{4}.[0-9]{4}"
                .Replacement.Text = ""
                .Wrap = wdFindContinue
                .Execute Replace:=wdReplaceAll
            End With
            Do While Not (myStoryRange.NextStoryRange Is Nothing)
               Set myStoryRange = myStoryRange.NextStoryRange
                With myStoryRange.Find
                    .Text = "<[A-Z]{3,}.[0-9]{4}.[0-9]{4}.[0-9]{4}"
                    .Replacement.Text = ""
                    .Wrap = wdFindContinue
                    .Execute Replace:=wdReplaceAll
                End With
            Loop
        End If
    Next myStoryRange
    However, it doesn't work with the hyperlink part of my code from above. I keep getting errors when I compile. Any ideas? I'm probably just trying to mash them together in the wrong spot.

  2. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,899
    Thanks
    0
    Thanked 188 Times in 172 Posts
    At its simplest, you could change 'wdDoc.Range' in your original macro to 'wdDoc.StoryRanges(wdFootnotesStory)'. Works for me.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  3. #3
    Lounger
    Join Date
    Dec 2011
    Posts
    27
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Thanks Paul! You're an absolute genius! Here I was, trying to mess around with the code, and all I had to do was that. So simple! Silly me. Thank you!!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •