liste variable de fichiers

Re : liste variable de fichiers

OK j'ai pas mal avancé sur le sujet.
Je créer ma liste 1, je la filtre, et j'ajoute les nouvelles entrées à ma liste 2.
Donc tout irait bien si la premiere colonne de la liste 1 n'était pas en réalité des liens hypertextes.
J'arrive donc à copier le "TextToDisplay:=Fichier.Name" mais je n'arrive pas à copier le " Hyperlinks.Add Anchor:=.Cells(L, 1), Address:=Chemin & Fichier.Name, _"

Re : liste variable de fichiers

Bonjour Tvi

Quelle est ta version d'Excel?

Bon OK XL2010 😱.

Pourrais-tu donner le code pour avoir la liste des fichiers ?

Re : liste variable de fichiers

voici le code complet (merci les auteurs de ce forum):

Sub AffichTest()
Sheets("Test").Activate
End Sub

Sub ScanClasseurs()
Dim Dossier As Object, Fichier As Object
Dim Chemin As String, CeFichier As String, ExtFichier As String
Dim TabDossiers As Variant
Dim L As Long, D As Long
Chemin = CheminUser
If Chemin = "" Then Exit Sub
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Test").Range("A2:B65536").Delete Shift:=xlUp
CeFichier = ThisWorkbook.Name
ExtFichier = UCase(Trim(ThisWorkbook.Sheets("Test").Range("Extension").Text))
L = 1
'Création du tableau des sous-dossiers existants
TabDossiers = lstDossiers(Chemin, True)
For D = 1 To UBound(TabDossiers)
'Chemin du dossier (ou sous-dossier) à analyser
Chemin = TabDossiers(D)
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
'Analyse du dossier (ou sous-dossier)
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In Dossier.Files
If Fichier.Name <> CeFichier Then
If ExtFichier = "" Or UCase(Right(Fichier.Name, 3)) = ExtFichier Then
'Liste les fichiers
L = L + 1
'MAJ feuille résultats
With ThisWorkbook.Sheets("Test")
.Cells(L, 1).Value = Chemin
.Hyperlinks.Add Anchor:=.Cells(L, 2), Address:=Chemin & Fichier.Name, _
TextToDisplay:=Fichier.Name
.Cells(L, 3).Value = Fichier.Type
.Cells(L, 4).Value = Fichier.Size
.Cells(L, 5).Value = Fichier.DateCreated
End With
End If
End If
Next
Next D
Set Dossier = Nothing
'Rétablit l'alerte de lien éventuelle dans les options Excel
Application.ScreenUpdating = True
MsgBox L - 1 & " fichiers trouvés !"
End Sub

Private Function lstDossiers(Chemin As String, Optional Debut As Boolean) As Variant
Dim Dossier As Object, SD As Object, D As Object
Static TabTemp() As String
If Debut Then
ReDim TabTemp(1 To 1)
TabTemp(1) = Chemin
End If
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
'examen du dossier courant
For Each D In Dossier.subfolders
ReDim Preserve TabTemp(1 To UBound(TabTemp) + 1)
TabTemp(UBound(TabTemp)) = D.Path
Next
'Traitement récursif des sous-dossiers (d'après un code de F.Sigonneau)
For Each SD In Dossier.subfolders
lstDossiers SD.Path
Next SD
lstDossiers = TabTemp()
Set Dossier = Nothing
End Function

Function CheminUser() As String
Dim objShell As Object, objFolder As Object
Dim Chemin As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Sélectionnez dans l'arborescence :", 513, 0)
If objFolder Is Nothing Then Exit Function
On Error Resume Next
Chemin = objFolder.Items.Item.Path & "\"
On Error GoTo 0
If Left(Chemin, 1) = ":" Then Chemin = ""
CheminUser = Chemin
End Function