Macro Excel 2003
Gervaisb
Messages postés
5
Date d'inscription
samedi 10 décembre 2005
Statut
Membre
Dernière intervention
27 février 2006
-
27 févr. 2006 à 00:50
jpleroisse Messages postés 1788 Date d'inscription mardi 7 novembre 2000 Statut Membre Dernière intervention 11 mars 2006 - 27 févr. 2006 à 14:21
jpleroisse Messages postés 1788 Date d'inscription mardi 7 novembre 2000 Statut Membre Dernière intervention 11 mars 2006 - 27 févr. 2006 à 14:21
3 réponses
jrivet
Messages postés
7392
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
60
27 févr. 2006 à 10:34
27 févr. 2006 à 10:34
Salut,
Tu peux essayer de voir si ceci peu t'aider. (il suffit de mettre en parametre le chemin du repertoire a lister, ainsi que la feuille ou tu veux le resultat)
ex: Call ListerRepertoire("C:", ActiveSheet)
Private Sub ListerRepertoire(CheminRep As String, ws As Worksheet)
Dim fs
Dim Repertoire
Dim Fi
Dim Fo
Dim NumLigne As Integer
ws.Range("A1").Value = "Fichiers"
ws.Range("B1").Value = "Repertoire"
NumLigne = 2
Set fs = CreateObject("Scripting.FileSystemObject")
Set Repertoire = fs.GetFolder(CheminRep)
'Lister les noms des Fichiers
For Each Fi In Repertoire.Files
ws.Range("A" & NumLigne).Value = Fi.Name
NumLigne = NumLigne + 1
Next
NumLigne = 2
'Lister les noms des sous repertoires
For Each Fo In Repertoire.SubFolders
ws.Range("B" & NumLigne).Value = Fo.Name
NumLigne = NumLigne + 1
Next
Set Repertoire = Nothing
Set fs = Nothing
End Sub
@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
Tu peux essayer de voir si ceci peu t'aider. (il suffit de mettre en parametre le chemin du repertoire a lister, ainsi que la feuille ou tu veux le resultat)
ex: Call ListerRepertoire("C:", ActiveSheet)
Private Sub ListerRepertoire(CheminRep As String, ws As Worksheet)
Dim fs
Dim Repertoire
Dim Fi
Dim Fo
Dim NumLigne As Integer
ws.Range("A1").Value = "Fichiers"
ws.Range("B1").Value = "Repertoire"
NumLigne = 2
Set fs = CreateObject("Scripting.FileSystemObject")
Set Repertoire = fs.GetFolder(CheminRep)
'Lister les noms des Fichiers
For Each Fi In Repertoire.Files
ws.Range("A" & NumLigne).Value = Fi.Name
NumLigne = NumLigne + 1
Next
NumLigne = 2
'Lister les noms des sous repertoires
For Each Fo In Repertoire.SubFolders
ws.Range("B" & NumLigne).Value = Fo.Name
NumLigne = NumLigne + 1
Next
Set Repertoire = Nothing
Set fs = Nothing
End Sub
@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
jpleroisse
Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Statut
Membre
Dernière intervention
11 mars 2006
27
27 févr. 2006 à 14:14
27 févr. 2006 à 14:14
Bonjour,
Ce code fonctionne avec Excel97, aucune raison qu'il ne fonctionne pas avec Excel 2003.
Sub Rep()
Dim f, row As Integer
row = 1
Cells.Clear
With Application.FileSearch
.LookIn = "C:\*.xls"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending
If .FoundFiles.Count > 0 Then
For Each f In .FoundFiles
Cells(row, 1) = f ' ou traitement(f)
row = row + 1
Next
End If
End With
End Sub
jpleroisse
Si une réponse vous convient, cliquez Réponse Acceptée.
Ce code fonctionne avec Excel97, aucune raison qu'il ne fonctionne pas avec Excel 2003.
Sub Rep()
Dim f, row As Integer
row = 1
Cells.Clear
With Application.FileSearch
.LookIn = "C:\*.xls"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending
If .FoundFiles.Count > 0 Then
For Each f In .FoundFiles
Cells(row, 1) = f ' ou traitement(f)
row = row + 1
Next
End If
End With
End Sub
jpleroisse
Si une réponse vous convient, cliquez Réponse Acceptée.
jpleroisse
Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Statut
Membre
Dernière intervention
11 mars 2006
27
27 févr. 2006 à 14:21
27 févr. 2006 à 14:21
Re,
Le code que je t'ais donné, concerne les fichiers .xls, pour tous les fichiers, utilise celui-ci.
Sub TousFichiers()
Dim fichier As String, indice
fichier = Dir("C:\*.*")
indice = 1
Do
If fichier = "" Then Exit Do
ThisWorkbook.Sheets(1).Cells(indice, 1) = fichier
indice = indice + 1
fichier = Dir()
Loop
End Sub
jpleroisse
Si une réponse vous convient, cliquez Réponse Acceptée.
Le code que je t'ais donné, concerne les fichiers .xls, pour tous les fichiers, utilise celui-ci.
Sub TousFichiers()
Dim fichier As String, indice
fichier = Dir("C:\*.*")
indice = 1
Do
If fichier = "" Then Exit Do
ThisWorkbook.Sheets(1).Cells(indice, 1) = fichier
indice = indice + 1
fichier = Dir()
Loop
End Sub
jpleroisse
Si une réponse vous convient, cliquez Réponse Acceptée.