Lien fichier Excel avec fichier PDF

Option Explicit

Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean

Dim NbFichiers As Long, NbDossiers As Long
Dim Dep As Currency, Fin As Currency, Freq As Currency
Dim r As Long
Const TypeFichier As String = "pdf"

Private Sub ListeFichiers(sDossier As String)
    DoEvents
    Application.ScreenUpdating = False
    QueryPerformanceCounter Dep

    ShFichiers.Cells.Clear
    r = 0: NbDossiers = 0: NbFichiers = 0

    ListeFichiersDansDossier sDossier, True
    'Tri
    
    QueryPerformanceCounter Fin: QueryPerformanceFrequency Freq
    With Application
        .StatusBar = "Dossiers : " & NbDossiers & " /  Fichiers : " & NbFichiers & " / " & TypeFichier & " : " & r & " / " & Format(((Fin - Dep) / Freq), "0.00 s")
        .ScreenUpdating = True
    End With
End Sub

Private Sub Tri()
    ShFichiers.Columns("A").Sort Key1:=.Range("A1"), Order1:=xlAscending
End Sub

Private Sub ListeFichiersDansDossier(sChemin As String, InclureSousDossiers As Boolean)
Dim FSO As Object, Dossier As Object, Fichier As String
Dim sPath As String

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FSO.GetFolder(sChemin)

    Fichier = Dir$(sChemin & "\*.*")
    Do While Len(Fichier) > 0
        NbFichiers = NbFichiers + 1
        sPath = sChemin & "\" & Fichier

        If UCase(TypeFichier) = UCase(FSO.GetExtensionName(Fichier)) Then
            r = r + 1
            ShFichiers.Hyperlinks.Add Anchor:=ShFichiers.Range("A" & r), _
                                      Address:=sPath, TextToDisplay:=CStr(Fichier)
        End If

        Fichier = Dir$()
        Application.StatusBar = "Dossiers : " & NbDossiers & " /  Fichiers : " & NbFichiers & " / " & TypeFichier & " : " & r
    Loop

    If InclureSousDossiers Then
        For Each Dossier In Dossier.SubFolders
            NbDossiers = NbDossiers + 1
            ListeFichiersDansDossier Dossier.Path, True
        Next Dossier
    End If

    Set Dossier = Nothing
    Set FSO = Nothing
End Sub

Sub SelDossier()
Dim sChemin As String

    sChemin = ThisWorkbook.Path
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = sChemin & "\"
        .Title = "Dossier à traiter"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .ButtonName = "Sélection Dossier"
        .Show
        If .SelectedItems.Count > 0 Then ListeFichiers .SelectedItems(1)
        ShFichiers.Range("C1").Select
    End With
End Sub