Lien hypertexte qui envoie directement dans un dossier Résolu

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

Votre réponse

Discussions similaires

Newsletters