Excel VBA: Sub routine or function to handle hyperlink clicks

Question

There's quite a bit of info about this to be found, but I haven't been able to get it to work for myself.

What I need to do is to have a global sub routine that catches hyperlink clicks for the whole document, not just the active sheet. Why? Because my workbook will have several links in several sheets, which are all "identical" except for their location (and contents of adjoining cells etc.).

This is easy to do with buttons - just connect all of them to the same macro - but I'm having problems doing the same with links.

This works, for one specific sheet:

In the Microsoft Excel Objects -> The worksheet in question:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    MsgBox "Link i Arket! " & Target.Range.Address
End Sub

When I click the link on the sheet in question, the VBA sub routine for the sheet catches the click and handles it.

The below code, I thought, "should" work for the whole document. That is, catch hyperlink clicks from any sheet in the worksbook. It does not (that is, nothing happens):

Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
    MsgBox "All sheets!"
End Sub

The links, in Excel, when hovering shows:

file://path/to/workbook.xlsm - click once to follow blablabla

What am I missing here?

Answer 1

You can reuse the same code for all worksheets by creating a class with a WithEvents worksheet object and storing the classes in a public collection.

Module1

Public objCollection As Collection

'Call on Workbook_Open
Sub CreateClasses()
Dim ws As Worksheet
Dim HyperlinksClass As cHyperlinks

    'Create A New Instance Of The Collection
    Set objCollection = New Collection
    'Loop All Worksheets
    For Each ws In Worksheets
        'Create A New Class For This Worksheet
        Set HyperlinksClass = New cHyperlinks
        'Add The Worksheet To The Class
        Set HyperlinksClass.obj = ws
        'Add The Class To The Collection
        objCollection.Add HyperlinksClass
    Next ws

End Sub

Create a class called cHyperlinks

Private WithEvents pWS As Worksheet

Private Sub pWS_FollowHyperlink(ByVal Target As Hyperlink)

    'Code to handle hyperlinks here

End Sub

Property Set obj(ByVal objWS As Worksheet)

    Set pWS = objWS

End Property