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. Subscribe to our Windows Secrets Newsletter - It's Free!

    Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,781
    Thanks
    0
    Thanked 162 Times in 150 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]

  4. #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
  •