XL 2016 Procédure événementielle à mettre sur thisworbook

[ZZ59264]

Bonjour à tous,

Pourriez vous me donner l'équivalent de ce code qui s'applique sur une feuille spécifique, mais je voudrait l'avoir sur thisworbook pour qu'il soit accessible sur toutes les feuilles du fichier :

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Dim s As String
    Dim cellules As String
    Dim Feuille As String
    Dim lienSplit() As String
    
    Application.ScreenUpdating = False
    lienSplit = Split(Target.SubAddress, "!")
    If UBound(lienSplit) >= 1 Then
        Feuille = Replace(lienSplit(0), "'", "")
        cellules = lienSplit(1)
        With Sheets(Feuille)
        If .Visible = False Then
        .Visible = True
        Application.GoTo .Range(cellules)
        End If
        End With
    Else
     MsgBox ("Lien non valide... " & Target.SubAddress)
    End If
End Sub

Il permet d'accéder a des liens sur des onglets masqués,

Merci d'avance,

Cordialement,

 

[Bernard_XLD]

Bonjour ZZ59264, le forum

pas testé mais cela devrait fonctionner comme cela, à placer dans le module ThisWorbook

Bien cordialement, @+
[code supprimé]

 

[ZZ59264]

Bonjour Yeahou,

Je l'ai testé sur le fichier joint mais cela ne fonctionne pas,

Merci pour ton aide,

Cordialement,

 

[Bernard_XLD]

Bonjour ZZ59264, le forum

avec un fichier de test fourni, cela va toujours mieux !

Bien cordialement, @+

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
    Dim lienSplit() As String
    Dim Feuille As String

    Application.ScreenUpdating = False
    lienSplit = Split(Target.SubAddress, "!")
    If UBound(lienSplit) >= 1 Then
        Feuille = Replace(lienSplit(0), "'", "")
        With ThisWorkbook.Sheets(Feuille)
            If .Visible = False Then
                .Visible = True
                Application.GoTo .Range(lienSplit(1))
            End If
        End With
    Else
        MsgBox ("Lien non valide... " & Target.SubAddress)
    End If
End Sub

 

[ZZ59264]

Bonjour Yeahou,

Aprés test, cela fonctionne parfaitement, c'est top !!!!! Merci beaucoup,

Bon réveillon à vous,

Cordialement,