Macro pour lien hypertexte

[Rose35]

bjr à tous,

voici mon soucis:

je saisis des noms dans 3 colonnes (A3 B3 C3)
en D3, je veux que se crée un lien hypertexte vers un classeur qui porterait le nom de ma saisie en A3 B3 C3 (une concaténation en fait)

mon pb, c'est que je n'arrive pas à automatiser la création du lien hypertexte vers un nouveau classeur.

j'espère avoir été claire

merci beaucoup

Rose

 

[michel]

bonjour Rose

la macro ci-dessous créée un lien hypertexte dans la cellule D3 en recuperant des données dans les cellules A3 à C3
il ne s'agit qu'un exemple et tu auras sans doute quelques adaptations à apporter


Sub creationHyperlien()
Dim monLien As String

monLien = Range("A3") & Range("B3") & Range("C3")

Range("D3") = "Cliquez sur le lien"
Feuil1.Hyperlinks.Add Anchor:=Range("D3"), Address:=monLien
End Sub


bonne soiree
MichelXld

 

[ChTi'160]

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