Lien hypertexte vers onglets masqués : erreur d'exécution 9
Résolu
Marine
-
Marine -
Marine -
Bonjour à tous !
J'ai un petit souci avec une macro que j'ai créée...
Je vous explique le contexte : j'ai un onglet Sommaire avec une liste de liens hypertextes qui renvoient à d'autres onglets, qui sont masqués.
Vu que ces onglets sont masqués, j'ai d'abord eu un problème pour faire fonctionner les liens hypertextes présent dans le Sommaire. J'ai donc créé cette macro (que j'ai trouvée sur un forum) :
Apparemment cette macro a résolu les problèmes de pas mal de gens dans le même cas que moi, mais pour ma part ça m'affiche une erreur d'exécution 9 "L'indice n'appartient pas à la sélection". Apparemment c'est la ligne
Des idées ? Merci ;)
J'ai un petit souci avec une macro que j'ai créée...
Je vous explique le contexte : j'ai un onglet Sommaire avec une liste de liens hypertextes qui renvoient à d'autres onglets, qui sont masqués.
Vu que ces onglets sont masqués, j'ai d'abord eu un problème pour faire fonctionner les liens hypertextes présent dans le Sommaire. J'ai donc créé cette macro (que j'ai trouvée sur un forum) :
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim s As String
With Sheets(Split(Target.SubAddress, "!")(0))
If .Visible = False Then
.Visible = True
Application.Goto .Range(Split(Target.SubAddress, "!")(1))
End If
End With
End Sub
Apparemment cette macro a résolu les problèmes de pas mal de gens dans le même cas que moi, mais pour ma part ça m'affiche une erreur d'exécution 9 "L'indice n'appartient pas à la sélection". Apparemment c'est la ligne
With Sheets(Split(Target.SubAddress, "!")(0))qui pose problème.
Des idées ? Merci ;)
3 réponses
-
Bonjour,
Pouvons nous faire un test, pour voir ce qui ne va pas?
Remplace le code donné dans ton message par :Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) MsgBox Target.SubAddress MsgBox Split(Target.SubAddress, "!")(0) End Sub
Et reviens nous donner le contenu exact des deux messages qui apparaissent lors d'1 clic sur un de tes liens
-
Bonjour,
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) Dim s As String Dim cellules As String Dim Feuille As String Dim lienSplit() As String lienSplit = Split(Target.SubAddress, "!") If UBound(lienSplit) >= 1 Then Feuille = 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
-
J'ai testé ton code jordane45. Malheureusement ça ne fonctionne pas :'(
Toujours la même erreur 9, pour la ligneWith Sheets(Feuille)
visiblement- Peut être :
- erreur d'orthographe entre le nom réel de la feuille et celui stocké dans l'hyperlien,
- les simple quote dans le nom de la feuille : '
si c'est la seconde solution (je n'y crois pas plus que cela...), essaye ceci :Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) Dim s As String Dim cellules As String Dim Feuille As String Dim lienSplit() As String 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
-
-
Code avec vérification de l'existence de la feuille ...
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) Dim s As String Dim cellules As String Dim Feuille As String Dim lienSplit() As String lienSplit = Split(Target.SubAddress, "!") If UBound(lienSplit) >= 1 Then Feuille = lienSplit(0) cellules = lienSplit(1) If FExist(Feuille) Then With Sheets(Feuille) If .Visible = False Then .Visible = True Application.Goto .Range(cellules) End If End With Else x = MsgBox("La feuille " & Feuille & " n'existe pas !", vbCritical, "Error") End If Else MsgBox ("Lien non valide... " & Target.SubAddress) End If End Sub Function FExist(NomF As String) As Boolean ' test si la feuille existe Application.ScreenUpdating = False On Error Resume Next FExist = Not Sheets(NomF) Is Nothing Application.ScreenUpdating = True End Function
-
Bizarre bizarre, en écrivant ton code jordane45 j'ai un message d'erreur me disant que ma feuille n'existe pas, quelque soit le lien sur lequel je clique...
Pourtant le code de pijaku marche parfaitement, c'est donc que ma feuille existe !- Oui, ta feuille existe, mais elle est référencée, dans l'hyperlink, entourée par des simple quoite.
En clair, dans ton lien, Feuil2 est notée 'Feuil2'.
Or, bien évidemment 'Feuil2' n'existe pas...
Il suffit donc (et c'est ce que fait mon code) d'enlever les ' :Feuille = Replace(lienSplit(0), "'", "")
-
-