Code VBA Lien hypertexte du fichier choisi dans cellule

Bonjour

Pouvez vous m'aider SVP .

Je cherche code VBA qui me permettrait d'aller chercher et de choisir un fichier dans un dossier avec un bouton, ceci afin de récupérer le nom de fichier dans une cellule du classeur en exemple ici "C11" et d'introduire le lien hypertexte dans la cellule "F11" inscrivant lien du document ceci afin de consulter chaque fichier .

Vous trouverez un fichier en pièce jointe avec en exemple un code VBA

Merci a vous pour votre aides ...

Bonjour,

Tu peux faire ainsi :

Sub lien()
Dim fd As Office.FileDialog
Dim sChemin As String
Dim sWbSource As String
Dim Derlign As Integer
Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
        .Filters.Clear
        .Title = "Coisir un fichier à insérer"
        .AllowMultiSelect = False

        If .Show = True Then
            sChemin = .SelectedItems(1)           ' Récup le chemin d'accès.
            sWbSource = Dir(.SelectedItems(1))    ' Récup le nom du fichier.
        End If
    End With

Derlign = Cells(30, 4).End(xlUp).Row + 1
Cells(Derlign, 4) = sWbSource
ActiveSheet.Hyperlinks.Add Anchor:=Cells(Derlign, 6), Address:=sChemin, TextToDisplay:="Lien du document"

  Set fd = Nothing
End Sub

Je l'ai fait sur ton fichier. Ne me demande pas pourquoi, j'ai aussi simplifié ta formule en colonne C qui était on ne peut plus dramatique. En colonne B, j'ai mis une liste déroulante avec les codes possibles. Le tableau de référence est en colonnes P et Q (J'ai eu la flemme d'aller jusqu'au bout cela dit).

Bonjour Fred

je tiens vraiment a te remercié pour ton aide qui a été rapide et très efficace , je recherchais le code depuis environ 1 semaine

alors merci encore .

Merci pour ce retour !

Bonjour,
Bonjour JouyeuxNoel,
Une petite modification, dans le cas d'une annulation...
Cdlt.

Sub lien()
Dim fd As Office.FileDialog
Dim sChemin As String, vCellule As String
Dim sWbSource As String
Dim Derlign As Long

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
        .Filters.Clear
        .Title = "Coisir un fichier à insérer"
        .AllowMultiSelect = False
        If .Show = True Then
            sChemin = .SelectedItems(1)           ' Récup le chemin d'accès.
            sWbSource = Dir(.SelectedItems(1))    ' Récup le nom du fichier.
            Derlign = Cells(30, 4).End(xlUp).Row + 1
            Cells(Derlign, 4) = sWbSource
            ActiveSheet.Hyperlinks.Add _
                    Anchor:=Cells(Derlign, 6), _
                    Address:=sChemin, _
                    TextToDisplay:="Lien du document"
        End If
    End With

    Set fd = Nothing

End Sub

Bonjour,

Ah oui exact, bien vu !

J'ai effectivement mal placé le end if.