Auto create a Hyperlink in VBA

Question

Hi,

I have created a Macro to Auto Create a Hyperlink to "Place in This Document".

I have created an Index where I place the Hyperlink, the Title in the Index is the same to where I want to go with the Hyperlink.

I have a problem, as if I just set the complete Title for the Hyperlink, it does not work on long Titles as it puts a "#" in front of the link.

If I tell it to only take the first so many Characters using "LEFT( TLinkS , nn)" it works for the one I am testing it on and Titles of less than the number, but it does not work on all.

if I set the length to "Number of Characters" it works, on that title but not on others.

Title                                           Number of Characters.

Boss                                            Works on Not set or any number

The Vampire Diaries 2: The Originals                               19

Two Pints of Larger and a Packet of Crisps                       12

You, Me and Them                                                           11

Here is a selection of my list of my current Titles...

2 Broke Girl$

24 Hours

24 Hours: Live Another Day

30 Rock

A League of Their Own

Ben & Kate

Boss

The Big ‘C’

Breaking Amish: Los AngelesBreaking

Amish: Brave New World

Brooklyn Nine-Nine

Doctor Who: The 12th Doctor

Don’t Trust the B**** in Apartment 23

Fact or Faked

F/X: The Series

Marvel’s Agents of S.H.I.E.L.D.

Police Women of…

The Vampire Diaries 2: The Originals

Two Pints of Larger and a Packet of Crisps

You, Me and Them

Here is my Macro...

Sub Hyperlink()

'Setting Hyperlink

    'System Settings

    Dim styStyle As Style

    Dim DandST As String

    Dim TLinkS As String

    Dim TLinkR As Range

    Application.ScreenUpdating = False

    StatusBar = "Please Wait...  Creating Hyperlink..."

    'Selecting the Programme Title

    With Selection

        .EndKey Unit:=wdLine

        .HomeKey Unit:=wdLine, _

            Extend:=wdExtend

    End With

    'Replace Spaces with '_'

    With Selection.Find

        .ClearFormatting

        .Replacement.ClearFormatting

        .Text = "^w"

        .Replacement.Text = "_"

        .Forward = True

        .Wrap = wdFindStop

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    'Set the Hyperlink

    TLinkS = Selection.Range

    Set TLinkR = Selection.Range

    'Replace '_' with Spaces

    With Selection.Find

        .ClearFormatting

        .Replacement.ClearFormatting

        .Text = "_"

        .Replacement.Text = " "

        .Forward = True

        .Wrap = wdFindStop

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    'Set the Display & ScreenTip

    DandST = Selection.Range

    'Set Hyperlink

    ActiveDocument.Hyperlinks.Add _

        Anchor:=TLinkR, _

        Address:="", _

        SubAddress:="_" & Left(TLinkS, 12), _

        ScreenTip:="Goto " & DandST & "...", _

        TextToDisplay:=DandST

    'Delete Hyperlink Style if it Exist...

    StatusBar = "Please Wait...  Deleting the Hyperlink Style..."

    For Each styStyle In ActiveDocument.Styles

        If styStyle.NameLocal = "Hyperlink" Then

                If styStyle.InUse Then

                    styStyle.Delete

                Exit For

                End If

        End If

    Next

    'Start Point

    With Selection

        .HomeKey Unit:=wdStory

    End With

    'System Settings

    Application.ScreenUpdating = True

    StatusBar = ""

End Sub

I have set the place I think the problem is in BOLDITALIC.

Thank you for looking in on this for me.

Neil

Answer 1

I tested the new Macro with your last part of code, but I got an error message when the Bookmark was being created.

When I hovered my mouse over the following Code:

     With Rng

          .End = .End - 1

          .Bookmarks.Add _

               Name:=StrBkMk, _

               Range:=Rng

     End With

I was given this feed back which I think the problem is that the '$' has not been replaced with a '_':

StrBkMk = "_2_Broke_Girl$_1"

Rng = "2 Broke Girl$"

Oops! Change:

StrBkMk = Replace(StrBkMk, Mid(StrEx, 1, 1), "")

to:

StrBkMk = Replace(StrBkMk, Mid(StrEx, i, 1), "")

Note: with my code, the $, etc are not replaced with _ characters; they're simply deleted. That way you don't end up with strings of ___ in the bookmark names. Instead, you get however more 'meaningful' characters can be combined for the bookmark name.

As for the other issues, I think you should continue the discussions in the other thread only; otherwise you risk getting conflicting advice because the issue is being approached in different ways.

Answer 2

Hi Paul,

To be honest, I have never used the Function of a Table of Contents.

With regards to bookmarks, I am not sure if I a using them officially too.

I will try to explain how I add items to my document.

1. I place the cursor into the last cell of the table(1) and "Press Tab" to add a new Row (2 columns), which are the first for the Programme Title, and the second to be created by a Macro.
2. I place the cursor to the very end of the Document by "Holding CTRL, and Pressing End".
3. I select the last table, and copy it to make the table for this new programme.
4. I Change the First Cell to the same name as I typed in the Index, and then set it to "Heading 1" style.
5. Change the other details for that programme, ie. Series/Season Number, then set the number of Rows to cover this Programmes Episodes.

So what I am doing is using "Heading 1" as the "SubAddress" via the "Place in This Document", section of the create a hyperlink.

I have worked out that if a Heading has spaces that Word replaces them with underscore ("_").

The problem is that sometimes after I've ran the macro to create the hyperlink, when I try to follow the macro I am sent to the top of the document instead of the table I've just added.  Then I "Right-Click" on the Index item containing the new hyperlink and select "Edit Hyperlink", the dialog opens under the tab: Link to: Existing File or Web Page, Look in: Current Folder, and the Address line reads "#_The_Vampire_Diaries_2:_The_Originals".

But what should happen when I "Right-Click" on the Index item and select "Edit Hyperlink" is...

Link to: Place in This Document.

Select a Place in this document: Headings: "The Vampire Diaries 2: The Originals".

I just cannot see why it is not linking under the correct section.

What I need to do, but don't know if it is possible, is to make sure that when the macro is creating the hyperlink that is does the following...

     Make sure that under "Link to:" is set to 'Place in This document'.

This is the only think I can think of which is causing the problem, as I think it is defaulting to 'Existing File or Web Page'.

Does this make sense to you, and do you know if this can be done?

Thanks,

Neil

Answer 3

I don't think you have understood my question...

So when I click on "The Vampire Diaries 2: The Originals" I want to be hyperlinked to "The Vampire Diaries 2: The Originals" somewhere lower down in the document.

What I need to know is how the "SubAddress" is created and referred to.

Perhaps I haven't understood.

I understand that you want to know "how the "SubAddress" is created and referred to". Well, that's what your code (and mine) is doing; it's creating the "SubAddress" with 'SubAddress:="_" & Left(TLinkS, 12)'. It seems to me, though, the real issue is whether the sub-address referred to by this actually exists. I can't answer that because I don't know what bookmarks are in your document.

From your description of the list, it seems you want the functionality of a Table of Contents. Is there a reason for not using one?

Answer 4

Hi Paul,

Thank you for your feedback I do like the way you've made the code simpler, but I don't think you have understood my question...

     The problem I'm having is the way the "SubAddress:=".

When I try to set the code it does not work all the time...

Title                                         Number of Characters.

Boss                                          Works on Not set or any number

The Vampire Diaries 2: The Originals          19

Two Pints of Larger and a Packet of Crisps    12

You, Me and Them                              11

     SubAddress:="_" & Left(TLinkS, 12)

In the above Line of Code, I need to change the Bold Number to the ones in the list above, but this is not possible to do when I run the macro.

The line of text that I'm wishing to Hyperlink to is both the same text in the Index file and the Title above the place I wish to go.

So when I click on "The Vampire Diaries 2: The Originals" I want to be hyperlinked to "The Vampire Diaries 2: The Originals" somewhere lower down in the document.

What I need to know is how the "SubAddress" is created and referred to.

If I was to right-click on the Index text, and select Hyperlink once the dialog appears I would click on "Place in This Document", then scroll down the list to find the heading, click it and my hyperlink is created.

I am trying to create the macro to do that for me.

Thank you for your help, and I hope this is more clear and you will be able to help me with my problem.

Yours,

Neil

Answer 5

Try:

Sub Hyperlink()

Application.ScreenUpdating = False

Dim TLinkR As Range, styStyle As Style

Dim DandST As String, TLinkS As String, TipTxt As String

StatusBar = "Please Wait...  Creating Hyperlink..."

'Selecting the Programme Title

With Selection

  .EndKey Unit:=wdLine

  .HomeKey Unit:=wdLine, Extend:=wdExtend

  Set TLinkR = .Range

  TLinkS = Replace(.Text, " ", "_")

  DandST = .Text

End With

TipTxt = DandST

If Len(TipTxt) > 12 Then TipTxt = Left(TipTxt, 12) & "..."

'Set Hyperlink

ActiveDocument.Hyperlinks.Add _

  Anchor:=TLinkR, Address:="", _

  SubAddress:="_" & Left(TLinkS, 12), _

  ScreenTip:="Goto " & TipTxt, _

  TextToDisplay:=DandST

Selection.HomeKey Unit:=wdLine

'Delete Hyperlink Style if it Exist...

StatusBar = "Please Wait...  Deleting the Hyperlink Style..."

For Each styStyle In ActiveDocument.Styles

  If styStyle.NameLocal = "Hyperlink" Then

    If styStyle.InUse Then

      styStyle.Delete

      Exit For

    End If

  End If

Next

Application.ScreenUpdating = True

StatusBar = ""

End Sub

Note the overall code simplification...