Liste Chercher Lien Hypertexte

Bonjour Le Forum !!!

En A3:A2000 j'ai une liste de nom sans lien hypertexte, j'aimerai à l'aide d'un bouton ajouter ce lien hypertexte de chacun de ces noms en allant pointer dans un dossier.

Mais la je ne sais pas comment faire en VBA :/

Bonjour,

Un bout de fichier exemple serait plus adapté.

  • On ne sait pas si tes noms de fichier sont indiqués avec leur extension ? .jpg , .xls , .pdf ? ….
  • Tu n'indiques pas si tous les fichiers sont dans le même dossier ?
  • Tu n'indique pas non plus 'l'adresse" de ce dossier ?

J'ai essayé ce code mais ça ne fonctionne pas...

Sub LienH()

    Dim i As Long
    Dim Dossier As String

    'chemin du dossier contenant les dossiers
    Dossier = "C:\Users\To\Desktop\PDF"

    'parcours les cellules
    For i = 4 To 200

        'vérifie que le fichié existe
        If Dir(Dossier & Cells(i, 1) & "*.pdf*") <> "" Then

            'création du lien
            Cel.Hyperlinks.Add Cel, Dossier & Cells(i, 1).Value

        End If

    Next i

End Sub

Bonjour,

Un bout de fichier exemple serait plus adapté.

- On ne sait pas si tes noms de fichier sont indiqués avec leur extension ? .jpg , .xls , .pdf ? ….

Ils sont indiqués Sans l'extension

- Tu n'indiques pas si tous les fichiers sont dans le même dossier ?

Mes Fichiers se trouverons toujours dans le même dossiers

- Tu n'indique pas non plus 'l'adresse" de ce dossier ?

Dossier = "C:\Users\To\Desktop\PDF"

Ton nom de Dossier n'est pas correcte.

Dossier = "C:\Users\To\Desktop\PDF" --> Dossier = "C:\Users\To\Desktop\PDF\"

Quand à la formulation pour l'ajout d'un lien hypertexte c'est plutôt :

ActiveSheet.Hyperlinks.Add Anchor:=Cel.Offset(i, 1), Address:= _

Dossier & Cel.Offset(i, 1).value &".pdf", TextToDisplay:=Cel.Offset(i, 1).value

Ton nom de Dossier n'est pas correcte.

Dossier = "C:\Users\To\Desktop\PDF" --> Dossier = "C:\Users\To\Desktop\PDF\"

Mince erreur bête.. Merci

Par contre pour l'ajout du lien hypertexte ça ne fonctionne pas ... il me met tous en surbrillance jaune..

Faut que je cherche la formulation dans une boucle

J'ai essayé avec ce que j'ai trouvé ici:

https://forum.excel-pratique.com/viewtopic.php?t=73553

Mais sans résultat encore..

Edit du 04/11/2019 : Personne ne sait faire ?

Bonjour le Forum,

Je permet de relancer n'ayant toujours aucune réponse et ne trouvant toujours pas de solution...

Cel n'est pas défini ici : Cel.Hyperlinks.Add

Ajoute pdf dans le lien hypertexte

Mon essai, à transposer :

Sub LienH()

    Dim i As Long
    Dim Dossier As String

    'chemin du dossier contenant les dossiers
    Dossier = "C:\Users\Michel\Downloads\"

    'parcours les cellules
    For i = 1 To 3

        'vérifie que le fichié existe
        If Dir(Dossier & Cells(i, 1) & "*.pdf*") <> "" Then

            'création du lien
            Cells(i, 1).Hyperlinks.Add Cells(i, 1), Dossier & Cells(i, 1).Value & ".pdf"

        End If

    Next i

End Sub

Bonjour Steelson !!

Je n'y croyait plus, je pensais bien que ce n'étais pas possible n'ayant aucune réponse.

J'ai retravaillé le code pour l'adapter suivant deux noms de cellules ça fonctionne au TOP merci beaucoup !!!

Pour infos si ça peut aider d'autres personnes...

Function LienHypertexte()
    Dim i As Long
    Dim Dossier As String

    DerLig = Range("B" & Rows.Count).End(xlUp).Row

    'chemin du dossier contenant les dossiers
    Dossier = "J:\Lien\PDF\"

    'parcours les cellules
    For i = 6 To DerLig

        If Cells(i, 3) = "/" Then
        W = ""
        Else
        W = "-" & Cells(i, 3)
        End If

        'vérifie que le fichié existe
        If Dir(Dossier & Cells(i, 2) & W & "*.pdf*") <> "" Then

            'création du lien
            Cells(i, 2).Hyperlinks.Add Cells(i, 2), Dossier & Cells(i, 2).Value & W & ".pdf"
        Else
        Cells(i, 2).Select
            With Selection.Font
            .Color = -16776961
            .TintAndShade = 0
            End With
        End If

    Next i
End Function

Merci Beaucoup Steelson !!

Rechercher des sujets similaires à "liste chercher lien hypertexte"