StephGuerain
XLDnaute Nouveau
Bonjour,
Je ne m'y connais pas vraiment en macro et j'ai récupérer pour mon boulot un fichier qui avait été fait avec Excel 2013 et nous sommes maintenant sur Excel 2016 et la macro ne fonctionne plus.
Donc j'ai créer un nouveau fichier et essaye de déchiffrer la macro, dans ce premier jet je pense que l'idée est d'aller récupérer les fichiers Excel d'un répertoire qui aura été sléectionné via une fenêtre par l'utilisateur :
Le code macro que j'ai associé à cela est le suivant :
Sub TestListeFichiers()
Dim Dossier As String
'Définit le répertoire pour débuter la recherche de fichiers.
'(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
'fichiers, sinon le temps de traitement va être très long).
UserForm1.Show
'Appelle la procédure de recherche des fichiers
ListeFichiers Dossier
'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
Sheets("Fichier à traiter").Columns("A:E").AutoFit
MsgBox "Analyse fichier terminé"
End Sub
Sub ListeFichiers(Repertoire As String)
'
'Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Dans l'éditeur de macros (Alt+F11):
'Menu Outils
'Références
'Cochez la ligne "Microsoft Scripting RunTime".
'Cliquez sur le bouton OK pour valider.
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim i As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Repertoire)
'Récupère le numéro de la dernière ligne vide dans la colonne A.
i = Range("A65536").End(xlUp).Row + 1
'Boucle sur tous les fichiers du répertoire
For Each FileItem In SourceFolder.Files
'Inscrit le nom du fichier dans la cellule
Sheets("Fichier à traiter").Cells(i, 1) = FileItem.Name
'Ajoute un lien hypertexte vers le fichier
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
Address:=FileItem.ParentFolder & "\" & FileItem.Name
'Indique la date de création
Sheets("Fichier à traiter").Cells(i, 2) = FileItem.DateCreated
'Indique la date de dernier acces
Sheets("Fichier à traiter").Cells(i, 3) = FileItem.DateLastAccessed
'Indique la date de dernière modification
Sheets("Fichier à traiter").Cells(i, 4) = FileItem.DateLastModified
'Nom du répertoire
Sheets("Fichier à traiter").Cells(i, 5) = FileItem.ParentFolder
i = i + 1
Next FileItem
'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.subfolders
ListeFichiers SubFolder.Path
Next SubFolder
End Sub
Mais cela ne fonctionne pas pouvez-vous m'aider déjà dans cette première étape svp
Merci
Je ne m'y connais pas vraiment en macro et j'ai récupérer pour mon boulot un fichier qui avait été fait avec Excel 2013 et nous sommes maintenant sur Excel 2016 et la macro ne fonctionne plus.
Donc j'ai créer un nouveau fichier et essaye de déchiffrer la macro, dans ce premier jet je pense que l'idée est d'aller récupérer les fichiers Excel d'un répertoire qui aura été sléectionné via une fenêtre par l'utilisateur :
Le code macro que j'ai associé à cela est le suivant :
Sub TestListeFichiers()
Dim Dossier As String
'Définit le répertoire pour débuter la recherche de fichiers.
'(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
'fichiers, sinon le temps de traitement va être très long).
UserForm1.Show
'Appelle la procédure de recherche des fichiers
ListeFichiers Dossier
'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
Sheets("Fichier à traiter").Columns("A:E").AutoFit
MsgBox "Analyse fichier terminé"
End Sub
Sub ListeFichiers(Repertoire As String)
'
'Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Dans l'éditeur de macros (Alt+F11):
'Menu Outils
'Références
'Cochez la ligne "Microsoft Scripting RunTime".
'Cliquez sur le bouton OK pour valider.
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim i As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Repertoire)
'Récupère le numéro de la dernière ligne vide dans la colonne A.
i = Range("A65536").End(xlUp).Row + 1
'Boucle sur tous les fichiers du répertoire
For Each FileItem In SourceFolder.Files
'Inscrit le nom du fichier dans la cellule
Sheets("Fichier à traiter").Cells(i, 1) = FileItem.Name
'Ajoute un lien hypertexte vers le fichier
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
Address:=FileItem.ParentFolder & "\" & FileItem.Name
'Indique la date de création
Sheets("Fichier à traiter").Cells(i, 2) = FileItem.DateCreated
'Indique la date de dernier acces
Sheets("Fichier à traiter").Cells(i, 3) = FileItem.DateLastAccessed
'Indique la date de dernière modification
Sheets("Fichier à traiter").Cells(i, 4) = FileItem.DateLastModified
'Nom du répertoire
Sheets("Fichier à traiter").Cells(i, 5) = FileItem.ParentFolder
i = i + 1
Next FileItem
'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.subfolders
ListeFichiers SubFolder.Path
Next SubFolder
End Sub
Mais cela ne fonctionne pas pouvez-vous m'aider déjà dans cette première étape svp
Merci