Salut"Rose35 "
bonsoir "michel"
je pense qu'en faisant une recherche sur le Forum rubrique "RECHERCHE"
tu devrais trouver bon nombre de sujets qui traite des liens Hypertext
ex d'une procedure de Didier(myDearFriend)
Auteur: myDearFriend (---.adsl.proxad.net)
Date: 13-10-04 00:06
Pièce jointe: PourSerge.zip (10k)
Bonsoir Serge, Jean-Marie (Chti160).
Ci-joint un exemple qui fonctionnera si les documents à lier se trouvent dans le même répertoire que ce classeur.
Jean-Marie, je suis parti approximativement sur la même base que toi...
Voici le code utilisé :
Public Sub CreerLiens()
Dim TabTemp As Variant
Dim L As Long
Dim Chemin As String
Dim Fichier As String
With Sheets("Feuil1")
'Supprime les liens existants
.Hyperlinks.Delete
'Charge les données dans un tableau variant temporaire
L = .Range("A65536").End(xlUp).Row
TabTemp = .Range(.Cells(5, 1), .Cells(L, 1)).Value
'Détermine le chemin du dossier
Chemin = ThisWorkbook.Path & "\"
'Pour chaque nom dans la colonne A
For L = 1 To UBound(TabTemp, 1)
'Crée le lien si le fichier (xls ou doc) existe
Fichier = FichierOk(Chemin & TabTemp(L, 1))
If Fichier <> "" Then
.Hyperlinks.Add Anchor:=.Cells(L + 4, 1), Address:=Fichier, _
TextToDisplay:=.Cells(L + 4, 1).Value
End If
Next L
End With
End Sub
Private Function FichierOk (F As String) As String
'Teste fichier xls
FichierOk = F & ".xls"
If Dir (FichierOk) <> "" Then Exit Function
'Teste fichier doc
FichierOk = F & ".doc"
If Dir (FichierOk) <> "" Then Exit Function
'Renvoie rien si ni xls, ni doc
FichierOk = ""
End Function
Cordialement,
Didier_mDF
A+++
Jean Marie