Lien hypertexte qui envoie directement dans un dossier Résolu/Fermé

Question

Bonjour, 

Ayant un fichier excel partagé, je ne peux pas utiliser la fonction hypertexte, j'ai pourtant besoin de renvoyer chaque ligne à un PDF.

J'ai donc utilisé le code suivant :

Sub LIENHYPERTEXTE()
Fichier = Application.GetOpenFilename
If Fichier = 0 Then Exit Sub
nom = Application.InputBox("Entrez le nom qui sera affiché", "DONNER UN NOM AU LIEN")
If nom = "" Or nom = 0 Then
MsgBox "Vous devez saisir un nom pour le lien", vbCritical + vbOKOnly
Exit Sub
End If
ActiveCell.Formula = "=HYPERLINK(""" & Fichier & """,""" & nom & """)"
End Sub

Problème : Lorsque je clique sur ma macro, j'arrive dans "Documents". Je souhaiterais spécifier le dossier où j'arrive directement pour gagner du temps. Tous les PDF à mettre en lien hypertexte s'y trouvent.

Merci d'avance pour votre aide.

Cordialement.

cs_Le Pivert · Answer

Bonjour,

A adapter:

Sub RechercheFichier()
    Dim fd As FileDialog
    Dim NomFichier As String
 Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Add "Pdf", "*.pdf"
        .Title = "Recherche de fichier"
        .InitialFileName = "C:\Users\.....\Documents\My eBooks"'a adapter
    End With
    If fd.Show = -1 Then NomFichier = fd.SelectedItems(1)
    MsgBox NomFichier
 Set fd = Nothing
End Sub

cs_Le Pivert · Answer

comme ceci:

Sub RechercheFichier()
    Dim fd As FileDialog
    Dim NomFichier As String
    Dim nom As String
     Dim tmpStr
 Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Add "Pdf", "*.pdf"
        .Title = "Recherche de fichier"
        .InitialFileName = "K:\ATTESTATION PERMANENTES LG FRET EUROPE"
    End With
    If fd.Show = -1 Then NomFichier = fd.SelectedItems(1)
  'si tu veux  récupérer le nom du fichier :
     tmpStr = Split(NomFichier, "\")
   tmpStr = tmpStr(UBound(tmpStr))
   tmpStr = Replace(tmpStr, ".pdf", "")
 nom = tmpStr
ActiveCell.Formula = "=HYPERLINK(""" & NomFichier & """,""" & nom & """)"
 Set fd = Nothing
End Sub

cs_Le Pivert · Answer

Petite correction, si l'utilisateur clique sur annuler dans la boite de dialogue:

Sub RechercheFichier()
    Dim fd As FileDialog
    Dim NomFichier As String
    Dim nom As String
    Dim tmpStr
 Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Add "Fichier Pdf", "*.pdf"
        .Title = "Recherche de fichier"
        .InitialFileName = "K:\ATTESTATION PERMANENTES LG FRET EUROPE"
    End With
    If fd.Show = -1 Then NomFichier = fd.SelectedItems(1)
 If NomFichier <> "" Then
'si tu veux  récupérer le nom du fichier :
     tmpStr = Split(NomFichier, "\")
   tmpStr = tmpStr(UBound(tmpStr))
   tmpStr = Replace(tmpStr, ".pdf", "")
 nom = tmpStr
ActiveCell.Formula = "=HYPERLINK(""" & NomFichier & """,""" & nom & """)"
 End If
 Set fd = Nothing
End Sub

Lien hypertexte qui envoie directement dans un dossier

3 réponses

Discussions similaires