lien hypertexte pointe vers une cellule d'une autre feuil

[Jarod51]

Salut à tous,

Je me demande s'il est possible dans Excel 2003 de faire la chose suivante 😕 :
Dans ma feuil1, j'ai des numéros qui sont des liens hypertextes et qui doivent pointer vers la même valeur contenu dans la cellule de la feuil2.

J'ai essayé tout bêtement de le faire avec un lien hypertexte mais il pointe uniquement vers un nom de cellule de la feuil2 et non pas vers la valeur 🙁

Je ne sais pas si c'est vraiment clair ce que je vous raconte, je vais vous faire un exemple.

Feuil1
N°
1 -> doit pointer sur la valeur 1 de la feuil2
2 -> doit pointer sur la valeur 2 de la feuil2
3 -> ...

Feuil2
1
1
3
2
5

Avez vous une idée si c'est faisable ?
Merci.

 

[pedrag31]

Re : lien hypertexte pointe vers une cellule d'une autre feuil

Bonjour Jarod51, Bonjour le forum,

Je te propose une solution avec une petite macro 😉... Voir fichier ci-joint.
A adapter ensuite à ton application...

La macro crée, pour chaque valeur qu'elle trouve dans la feuille 2, une liste de liens dans la feuille 1.
Tu récupères ainsi une liste du type:

Valeur A, Lien 1, Lien 2, Lien 3, ...
Valeur B, Lien 1, Lien 2, Lien 3, ...
Valeur C, Lien 1, Lien 2, Lien 3, ...
Valeur D, Lien 1, Lien 2, Lien 3, ...

Bonne journée 🙂

 

[Jarod51]

Re : lien hypertexte pointe vers une cellule d'une autre feuil

salut pedrag31,

Merci pour ton fichier, malheuresement, je suis sous Excel 2003 et impossible de lancer la macro contenue dans ton fichier xlsm 🙁.

 

[pedrag31]

Re : lien hypertexte pointe vers une cellule d'une autre feuil

Re,

Fichier en xls pour Excel 2003 joint.
Penses à renseigner correctement ton profil, on sait de suite quelle version tu utilises comme ça!

++

Bonne journée 🙂

 

[job75]

Re : lien hypertexte pointe vers une cellule d'une autre feuil

Bonjour Jarod51, pedrag31,

Voyez le fichier joint avec cette macro dans ThisWorkbook :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim F1 As Worksheet, F2 As Worksheet, cel As Range, cible As Range
Set F1 = Feuil1 'CodeName, à adapter
Set F2 = Feuil2 'CodeName, à adapter
F1.Hyperlinks.Delete 'supprime tous les liens hypertexte
F1.[A:A].Font.FontStyle = "Normal" 'format police
F1.[A1].Font.Bold = True 'gras
For Each cel In F1.Range("A2", F1.[A65536].End(xlUp)) 'plage/colonne à adapter
  If cel.Text <> "" Then
    Set cible = F2.Cells.Find(cel.Text, , xlValues, xlWhole)
    If Not cible Is Nothing Then _
      F1.Hyperlinks.Add cel, "", F2.CodeName & "!" & cible.Address
  End If
Next
End Sub

Les liens hypertexte s'ajustent aux valeurs en Feuil1 et Feuil2.

A+

 

[job75]

Re : lien hypertexte pointe vers une cellule d'une autre feuil

Re,

La remise à zéro du format police n'allait pas :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim F1 As Worksheet, F2 As Worksheet, cel As Range, cible As Range
Set F1 = Feuil1 'CodeName, à adapter
Set F2 = Feuil2 'CodeName, à adapter
F1.Hyperlinks.Delete 'supprime tous les liens hypertexte
F1.[A:A].Font.ColorIndex = xlAutomatic 'format police
F1.[A:A].Font.Underline = xlUnderlineStyleNone
For Each cel In F1.Range("A2", F1.[A65536].End(xlUp)) 'plage/colonne à adapter
  If cel.Text <> "" Then
    Set cible = F2.Cells.Find(cel.Text, , xlValues, xlWhole)
    If Not cible Is Nothing Then _
      F1.Hyperlinks.Add cel, "", F2.CodeName & "!" & cible.Address
  End If
Next
End Sub

Fichier (2).

A+

 

[Jarod51]

Re : lien hypertexte pointe vers une cellule d'une autre feuil

Salut job75,
wahou ! Ca marche super bien ta macro. C'est exactement ce que je cherchais. Merci encore.

 

[Jarod51]

Re : lien hypertexte pointe vers une cellule d'une autre feuil

Salut job75,

y aurait il un moyen de changer la police de caractère et la taille de la police dans le script ? Je ne vois pas où ça se passe dans ta macro 🙁. Je préfère être en Arial 10 au lieu d'être en Callibri.

 

[pedrag31]

Re : lien hypertexte pointe vers une cellule d'une autre feuil

Bonjour Jarod51, Job75, Le forum,

Super macro Job75, bcp plus simple que mon usine à gaz en fait!
Peut être serait-il intéressant d'intégrer la gestion des doublons dans un deuxième temps, pour optimiser...😉

Il faut insérer la mise en forme de la cellule "cel" après l'ajout de l'hyperlien:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim F1 As Worksheet, F2 As Worksheet, cel As Range, cible As Range
Set F1 = Feuil1 'CodeName, à adapter
Set F2 = Feuil2 'CodeName, à adapter
F1.Hyperlinks.Delete 'supprime tous les liens hypertexte
F1.[A:A].Font.ColorIndex = xlAutomatic 'format police
F1.[A:A].Font.Underline = xlUnderlineStyleNone

For Each cel In F1.Range("A2", F1.[A65536].End(xlUp)) 'plage/colonne à adapter
  If cel.Text <> "" Then
    Set cible = F2.Cells.Find(cel.Text, , xlValues, xlWhole)
    If Not cible Is Nothing Then _
      F1.Hyperlinks.Add cel, "", F2.CodeName & "!" & cible.Address
        
        '### MISE EN FORME POLICE ###
        cel.Font.Name = "Arial"
        cel.Font.Size = 10

  End If
Next
End Sub

Bonne journée 🙂

 

[pedrag31]

Re : lien hypertexte pointe vers une cellule d'une autre feuil

Re,

Allez, je m'aventure avec une petite adaptation pour gérer les doublons que l'on trouve dans la recherche...😀
J'ai développé une certaine parano pour les doublons 🙄 ...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)

Dim F1 As Worksheet, F2 As Worksheet, cel As Range, cible As Range, firstAddress As String, TexteCellule As String
Set F1 = Feuil1 'CodeName, à adapter
Set F2 = Feuil2 'CodeName, à adapter
F1.Hyperlinks.Delete 'supprime tous les liens hypertexte
F1.[A:A].Font.ColorIndex = xlAutomatic 'format police
F1.[A:A].Font.Underline = xlUnderlineStyleNone

For Each cel In F1.Range("A2", F1.[A65536].End(xlUp)) 'plage/colonne à adapter
    If cel.Text <> "" Then
        
        Set cible = F2.Cells.Find(cel.Text, , xlValues, xlWhole)
        TexteCellule = cel.Text
        
        If Not cible Is Nothing Then
            
            firstAddress = cible.Address

            Do
                F1.Hyperlinks.Add cel, "", F2.CodeName & "!" & cible.Address, TextToDisplay:=TexteCellule
                cel.Font.Name = "Arial"
                cel.Font.Size = 10
                Set cel = cel.Offset(0, 1)
                Set cible = F2.Cells.FindNext(cible)
            Loop While Not cible Is Nothing And cible.Address <> firstAddress

        
        End If
    
    End If
Next cel
End Sub

Bonne journée 🙂

 

[Jarod51]

Re : lien hypertexte pointe vers une cellule d'une autre feuil

Salut,

whaou, super macro pedrag31 ! 😀

Beau boulot !
Merci encore.
A+