Liste repertoire Windows c:\ dans feuille Excel

Bonjour à tous

Cette macro me permet de lister des fichiers dans un répertoire Windows:C:\ et de les insérer dans une feuille excel avec des liaisons pour pouvoir ouvrir les documents directement à partir de cette feuille. Mon souci est qu'il me faudrait transformer cette macro pour obtenir cette liste de fichier avec lien par une mise à jour à l'ouverture du fichier. Peut importe les nouveaux fichiers ajoutés.

Merci par avance.

Cordialement

Option Explicit

'Rep : le répertoire à traiter contenant le chemin complet

'Cel : la 1èr cellule où écrire

Sub MAJRepertoire(Rep As String, Cel As Range)

Dim Obj, RepP, F, Fich, P

Dim Lig As Long, Col As Long, DerLig As Long, i As Long

Dim LigEcrire As Long, NbFichier As Long

Dim S As String, TB

Set P = Cel.Parent 'Certifier la feuille où écrire

P.Activate

Lig = Cel.Row: Col = Cel.Column

With P

DerLig = .Cells(.Rows.Count, Col).End(xlUp).Row

If DerLig <= Lig Then

'Au cas ou la 1ère ligne ne serait pas à 1 et que le fichier est vide

DerLig = Lig - 1: LigEcrire = Lig

Else

'Le fichier n'est pas vide, initialise la 1ère ligne où ajouter

LigEcrire = DerLig + 1

End If

If Right(Rep, 1) <> "\" Then Rep = Rep & "\"

Set Obj = CreateObject("Scripting.FileSystemObject")

Set RepP = Obj.Getfolder(Rep)

Set Fich = RepP.Files

'Vérifie si des fichiers ont étés ajoutés.

'Si non, sort de la sub

If Fich.Count = DerLig - Lig + 1 Then Exit Sub

Application.ScreenUpdating = False

For Each F In Fich

'vérification si existe déjà

For i = Lig To DerLig

If .Cells(i, Col) = F.Name Then Exit For

Next i

If i > DerLig Then 'existe pas et l'ajoute

TB = Split(F.Name, ".")

.Cells(LigEcrire, Col).Select

.Hyperlinks.Add Anchor:=Selection, Address:= _

Rep & F.Name, TextToDisplay:=TB(0)

LigEcrire = LigEcrire + 1

End If

Next

End With

End Sub

Bonjour,

tu peux mettre l'appel de la macro dans la procédure Workbook_open

par exemple

Private Sub Workbook_Open()
call MAJrepertoire ("C:", range("A1"))
End Sub

Bonjour

Je vais essayer

Merci beaucoup

Cordialement.