Problème Excel 2016, mise à jour automatique des hyperliens avec la dernièr

Bonjour,

Je travail actuellement sur un projet, je voudrais, grâce à des formules (ou des macros),mettre en hyperlien un document avec sa dernière révision et que l'hyperlien soit mise à jour, en lien avec la dernière révision.

Exemple : "Doc Essais rev A02" , l'hyperlien dans l'Excel sera sur ce document, puis si je rajoute un "Doc Essais rev A03" dans le dossier, l'hyperlien sera sur cette dernière revivon ect... de façon automatique ou presque...

Merci d'avance pour votre aide , Benoit,

Bonjour,

Une piste à adapter. Attention toutes fois, les noms des fichiers (ici Excel mais tu peux modifier l'extension en .doc ou autre) doivent impérativement se terminer par un nombre (03, 04, 12, 255, etc...). La cellule cible du lien est ici A1, adaptes :

Sub Test()

    Dim Tbl() As String
    Dim Chemin As String
    Dim Fichier As String
    Dim I As Integer
    Dim Max As Long
    Dim Nombre As Long

    'si différent du classeur contenant la macro, adapter le chemin !
    Chemin = ThisWorkbook.Path

    'récupère les fichiers .doc (.xls, .slsx, .xlsm, etc...)
    Tbl = RecupFichiers(Chemin, ".xls")

    If Not (Not Tbl) Then

        For I = 1 To UBound(Tbl)

            'supprime l'extension du fichier
            Fichier = Replace(Tbl(I), "." & Split(Tbl(I), ".")(1), "")

            On Error Resume Next 'au cas où le fichier ne comporte pas de nombre à la fin !

            'extrait le nombre ce qui oblige des noms de fichier : "Doc Essais rev A03", "Doc Essais rev A04", etc...
            Nombre = (CLng(Mid(Fichier, InStrRev(Fichier, " ") + 2, Len(Fichier) - InStrRev(Fichier, " ") + 2)))

            'recherche le nombre le plus élevé et récupère le nom du fichier correspondant
            If Max < Nombre Then

                Max = Nombre
                Fichier = Tbl(I)

            End If

        Next I

        'lien hypertexte en A1, à adapter...
        Range("A1").Hyperlinks.Add Range("A1"), Chemin & Fichier

    End If

End Sub

Function RecupFichiers(Chemin As String, Ext As String) As String()

    Dim TblFichiers() As String
    Dim Fichier As String
    Dim I As Integer

    If Right(Chemin, Len(Chemin)) <> "\" Then Chemin = Chemin & "\"

    Fichier = Dir(Chemin & "*" & Ext & "*")

    Do While (Len(Fichier) > 0)

        I = I + 1
        ReDim Preserve TblFichiers(1 To I)
        TblFichiers(I) = Fichier
        Fichier = Dir()

    Loop

    RecupFichiers = TblFichiers()

End Function

Génial, merci pour votre aide !