adapter un code d'excelabo

Le
Sunburn
Bonjour,
j'ai trouvé un code sur excelabo, qui me conviendrait dans l'esprit, mais je
n'arrive pas à l'adapter. voici le lien:
http://excelabo.net/excel/compteclic.php?nom=mpfc-repertoires
alors voila. ce classeur permet de lister les fichiers du type que l'on
veut, dans le repertoire que l'on veut, en faisant des liens hypertextes, à
partir d'un bouton de commande.
moi, je voudrais un truc un peu plus simple, c'est à dire définir le type de
fichier à *.*, et le répertoire au sous repertoire du fichier excel actif.
je m'explique, je travail sous mon fichier tintin.xls. il se situe dans
C:TESTMACHINBIDULE, donc moi je voudrais les fichiers *.* du dossier
MACHIN et de tous ses sous-dossiers, sans demander l'avis de l'utilisateur.

Petite particularité, mon bouton de commande se situe dans une barre d'outils.

Est-ce possible selon vous ?
et comment puis-je adapter ce classeur, selon vous ?
Merci beaucoup.
YANN
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Jacky
Le #18144181
Bonjour,

Liste les fichiers d'un répertoire défini
'-----------------------
Sub jj()
Chemin = dir("C:TESTMACHIN*.*") '*A adapter
Do Until Chemin = ""
MsgBox Chemin
Chemin = dir
Loop
End Sub
'-------------------------
--
Salutations
JJ


"Sunburn" news:
Bonjour,
j'ai trouvé un code sur excelabo, qui me conviendrait dans l'esprit, mais
je
n'arrive pas à l'adapter. voici le lien:
http://excelabo.net/excel/compteclic.php?nom=mpfc-repertoires
alors voila. ce classeur permet de lister les fichiers du type que l'on
veut, dans le repertoire que l'on veut, en faisant des liens hypertextes,
à
partir d'un bouton de commande.
moi, je voudrais un truc un peu plus simple, c'est à dire définir le type
de
fichier à *.*, et le répertoire au sous repertoire du fichier excel actif.
je m'explique, je travail sous mon fichier tintin.xls. il se situe dans
C:TESTMACHINBIDULE, donc moi je voudrais les fichiers *.* du dossier
MACHIN et de tous ses sous-dossiers, sans demander l'avis de
l'utilisateur.

Petite particularité, mon bouton de commande se situe dans une barre
d'outils.

Est-ce possible selon vous ?
et comment puis-je adapter ce classeur, selon vous ?
Merci beaucoup.
YANN



Sunburn
Le #18144421
re,
en fait, le chemin n'est jamais le meme, il n'est pas fixe.
j'ai modifié le code comme ceci, afin de retreindre les choix deja.
Mais il y a beaucoup d'autres codes dans cet exemple , et je ne sais pas si
je peux les supprimer.
De plus, mon chemin est thisworkbook.Path, mais comment dire que c'est le
dossier précédent de "ThisWorkbook.Path" au niveau de l'architecture ?
Merci de votre aide.
YANN

-----
Sub Repertorier()
'Une méthode basique sans API pour lister les répertoires et
'sous-répertoires. Michel Pierron, MPFE 2002. Adaptation Flo Cabon sur une
idée de "mrik"
'* nRow = Ligne de départ
'* FolderName = Chemin du répertoire à lister
'* Suffix = Filtre optionnel des types de fichiers
'* SubDir = True pour étendre la liste aux sous-répertoires
Dim LeMessage As String, LeRepertoire As String, Lextension As String
Dim Profondeur As VbMsgBoxResult
Dim nRow As Long

LeMessage = "Choisissez le dossier à analyser"
LeRepertoire = ThisWorkbook.path
Lextension = "*.*"
'Profondeur = MsgBox("Voulez vous analyser aussi les sous-répertoires ?",
vbYesNo, "Profondeur d'analyse")
nRow = 1
'If Profondeur = vbYes Then
truc = Lister(nRow, LeRepertoire, Lextension, True)
'Else
'truc = Lister(nRow, LeRepertoire, Lextension, False)
'End If
End Sub
-----
et voila tout les codes du module :
-----
'Les déclarations et la fonction getdirectory qui suivent
'permettent d'ouvrir une boite de dialogue de type "choix d'un dossier"
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String)
As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
Dim Dossier As String
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez un dossier de destination pour les sauvegardes."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & ""
Else
GetDirectory = ""
End If
End Function

Sub Repertorier()
'Une méthode basique sans API pour lister les répertoires et
'sous-répertoires. Michel Pierron, MPFE 2002. Adaptation Flo Cabon sur une
idée de "mrik"
'* nRow = Ligne de départ
'* FolderName = Chemin du répertoire à lister
'* Suffix = Filtre optionnel des types de fichiers
'* SubDir = True pour étendre la liste aux sous-répertoires
Dim LeMessage As String, LeRepertoire As String, Lextension As String
Dim Profondeur As VbMsgBoxResult
Dim nRow As Long

LeMessage = "Choisissez le dossier à analyser"
LeRepertoire = ThisWorkbook.path
Lextension = "*.*"
'Profondeur = MsgBox("Voulez vous analyser aussi les sous-répertoires ?",
vbYesNo, "Profondeur d'analyse")
nRow = 1
'If Profondeur = vbYes Then
truc = Lister(nRow, LeRepertoire, Lextension, True)
'Else
'truc = Lister(nRow, LeRepertoire, Lextension, False)
'End If
End Sub

Function Lister(nRow&, FolderName$, Optional Suffix$ = "*.*", Optional
SubDir As Boolean = True)
Dim i As Long, x As Long, File As String, Folder As String, nbFolders() As
String
Cells(nRow, 1) = FolderName
Cells(nRow, 1).Font.Bold = True
If Not Right(FolderName, 1) = "" Then FolderName = FolderName & ""
File = Dir(FolderName & Suffix)

Do While Len(File) > 0
With ActiveSheet
.Hyperlinks.Add Anchor:=.Cells(nRow, 2), _
Address:=FolderName & File, _
TextToDisplay:=File
End With
nRow = nRow + 1
File = Dir
Loop

If Not SubDir Then Exit Function
x = 0
Folder = Dir(FolderName, vbDirectory)

Do While Folder > ""
If Folder If (GetAttr(FolderName & Folder) And vbDirectory) = vbDirectory Then x
= x + 1
End If
Folder = Dir
Loop

ReDim nbFolders(x + 1)
i = 1
nbFolders(i) = Dir(FolderName, vbDirectory)
Do While nbFolders(i) > ""
If nbFolders(i) If (GetAttr(FolderName & nbFolders(i)) And vbDirectory) = vbDirectory
Then i = i + 1
End If
nbFolders(i) = Dir
Loop
For i = 1 To UBound(nbFolders()) - 1
Call Lister(nRow, FolderName & nbFolders(i), Suffix)
Next
End Function
------
JB
Le #18145031
Bonjour,

Sub arborescence()
'Cocher Microsoft Scripting RunTime
racine = "c:mesdocexcelmacronouveau" 'adapter
Range("A:E").Clear
Range("A3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine, 1
Range("A1").Select
End Sub

Sub Lit_dossier(ByRef dossier, ByVal niveau)
ActiveCell.Value = String(3 * niveau - 1, " ") & dossier.Name & "["
& dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
Lit_dossier d, niveau + 1
Next
For Each f In dossier.Files
nom_fich = f.Name
ActiveCell = String(3 * niveau - 1, " ") & f.Name
ActiveCell.Offset(0, 1) = f.Size
ActiveCell.Offset(0, 2) = f.DateLastModified
ActiveCell.Offset(0, 3) = f.Attributes
If f.Attributes And vbHidden Then ActiveCell.Offset(0, 4) =
"Caché"
ActiveCell.Interior.ColorIndex = 2
ActiveCell.Offset(1, 0).Select
Next
End Sub


JB
http://boisgontierjacques.free.fr/

On 15 déc, 11:58, Sunburn
Bonjour,
j'ai trouvé un code sur excelabo, qui me conviendrait dans l'esprit, ma is je
n'arrive pas à l'adapter. voici le lien:http://excelabo.net/excel/compt eclic.php?nom=mpfc-repertoires
alors voila. ce classeur permet de lister les fichiers du type que l'on
veut, dans le repertoire que l'on veut, en faisant des liens hypertextes, à
partir d'un bouton de commande.
moi, je voudrais un truc un peu plus simple, c'est à dire définir le type de
fichier à *.*, et le répertoire au sous repertoire du fichier excel a ctif.
je m'explique, je travail sous mon fichier tintin.xls. il se situe dans
C:TESTMACHINBIDULE, donc moi je voudrais les fichiers *.* du dossier
MACHIN  et de tous ses sous-dossiers, sans demander l'avis de l'utilisa teur.

Petite particularité, mon bouton de commande se situe dans une barre d' outils.

Est-ce possible selon vous ?
et comment puis-je adapter ce classeur, selon vous ?
Merci beaucoup.
YANN


Jacky
Le #18145121
Re...
Moins compliqué, mais aussi moins pro.
'-------------
Sub jj()
For i = Len(ActiveWorkbook.Path) To 1 Step -1
If Mid(ActiveWorkbook.Path, i, 1) = "" Then Chemin = _
Left(ActiveWorkbook.Path, i): Exit For
Next
MsgBox "Ancien chemin ==>" & ActiveWorkbook.Path & Chr(10) _
& "Nouveau chemin ==>" & Chemin '**facultatif
Nom = dir(Chemin)
Do Until Nom = ""
MsgBox Nom
Nom = dir
Loop
End Sub
'----------------------------

--
Salutations
JJ


"Sunburn" news:
re,
en fait, le chemin n'est jamais le meme, il n'est pas fixe.
j'ai modifié le code comme ceci, afin de retreindre les choix deja.
Mais il y a beaucoup d'autres codes dans cet exemple , et je ne sais pas
si
je peux les supprimer.
De plus, mon chemin est thisworkbook.Path, mais comment dire que c'est le
dossier précédent de "ThisWorkbook.Path" au niveau de l'architecture ?
Merci de votre aide.
YANN

-----
Sub Repertorier()
'Une méthode basique sans API pour lister les répertoires et
'sous-répertoires. Michel Pierron, MPFE 2002. Adaptation Flo Cabon sur une
idée de "mrik"
'* nRow = Ligne de départ
'* FolderName = Chemin du répertoire à lister
'* Suffix = Filtre optionnel des types de fichiers
'* SubDir = True pour étendre la liste aux sous-répertoires
Dim LeMessage As String, LeRepertoire As String, Lextension As String
Dim Profondeur As VbMsgBoxResult
Dim nRow As Long

LeMessage = "Choisissez le dossier à analyser"
LeRepertoire = ThisWorkbook.path
Lextension = "*.*"
'Profondeur = MsgBox("Voulez vous analyser aussi les sous-répertoires ?",
vbYesNo, "Profondeur d'analyse")
nRow = 1
'If Profondeur = vbYes Then
truc = Lister(nRow, LeRepertoire, Lextension, True)
'Else
'truc = Lister(nRow, LeRepertoire, Lextension, False)
'End If
End Sub
-----
et voila tout les codes du module :
-----
'Les déclarations et la fonction getdirectory qui suivent
'permettent d'ouvrir une boite de dialogue de type "choix d'un dossier"
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String)
As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
Dim Dossier As String
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez un dossier de destination pour les
sauvegardes."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & ""
Else
GetDirectory = ""
End If
End Function

Sub Repertorier()
'Une méthode basique sans API pour lister les répertoires et
'sous-répertoires. Michel Pierron, MPFE 2002. Adaptation Flo Cabon sur une
idée de "mrik"
'* nRow = Ligne de départ
'* FolderName = Chemin du répertoire à lister
'* Suffix = Filtre optionnel des types de fichiers
'* SubDir = True pour étendre la liste aux sous-répertoires
Dim LeMessage As String, LeRepertoire As String, Lextension As String
Dim Profondeur As VbMsgBoxResult
Dim nRow As Long

LeMessage = "Choisissez le dossier à analyser"
LeRepertoire = ThisWorkbook.path
Lextension = "*.*"
'Profondeur = MsgBox("Voulez vous analyser aussi les sous-répertoires ?",
vbYesNo, "Profondeur d'analyse")
nRow = 1
'If Profondeur = vbYes Then
truc = Lister(nRow, LeRepertoire, Lextension, True)
'Else
'truc = Lister(nRow, LeRepertoire, Lextension, False)
'End If
End Sub

Function Lister(nRow&, FolderName$, Optional Suffix$ = "*.*", Optional
SubDir As Boolean = True)
Dim i As Long, x As Long, File As String, Folder As String, nbFolders()
As
String
Cells(nRow, 1) = FolderName
Cells(nRow, 1).Font.Bold = True
If Not Right(FolderName, 1) = "" Then FolderName = FolderName & ""
File = Dir(FolderName & Suffix)

Do While Len(File) > 0
With ActiveSheet
.Hyperlinks.Add Anchor:=.Cells(nRow, 2), _
Address:=FolderName & File, _
TextToDisplay:=File
End With
nRow = nRow + 1
File = Dir
Loop

If Not SubDir Then Exit Function
x = 0
Folder = Dir(FolderName, vbDirectory)

Do While Folder > ""
If Folder If (GetAttr(FolderName & Folder) And vbDirectory) = vbDirectory Then
x
= x + 1
End If
Folder = Dir
Loop

ReDim nbFolders(x + 1)
i = 1
nbFolders(i) = Dir(FolderName, vbDirectory)
Do While nbFolders(i) > ""
If nbFolders(i) If (GetAttr(FolderName & nbFolders(i)) And vbDirectory) = vbDirectory
Then i = i + 1
End If
nbFolders(i) = Dir
Loop
For i = 1 To UBound(nbFolders()) - 1
Call Lister(nRow, FolderName & nbFolders(i), Suffix)
Next
End Function
------


Sunburn
Le #18145111
Bonjour,
en fait, je voulais une liste de mes fichiers en colonne A par exemple, et
les liens correspondant en colonne F par exemple.
et la racine est différente à chaque fois, en fait elle est
activeworkbook.path, mais le niveau précédent, ça je ne sais pas faire.
Yann

"JB" a écrit :

Bonjour,

Sub arborescence()
'Cocher Microsoft Scripting RunTime
racine = "c:mesdocexcelmacronouveau" 'adapter
Range("A:E").Clear
Range("A3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine, 1
Range("A1").Select
End Sub

Sub Lit_dossier(ByRef dossier, ByVal niveau)
ActiveCell.Value = String(3 * niveau - 1, " ") & dossier.Name & "["
& dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
Lit_dossier d, niveau + 1
Next
For Each f In dossier.Files
nom_fich = f.Name
ActiveCell = String(3 * niveau - 1, " ") & f.Name
ActiveCell.Offset(0, 1) = f.Size
ActiveCell.Offset(0, 2) = f.DateLastModified
ActiveCell.Offset(0, 3) = f.Attributes
If f.Attributes And vbHidden Then ActiveCell.Offset(0, 4) > "Caché"
ActiveCell.Interior.ColorIndex = 2
ActiveCell.Offset(1, 0).Select
Next
End Sub


JB
http://boisgontierjacques.free.fr/

On 15 déc, 11:58, Sunburn > Bonjour,
> j'ai trouvé un code sur excelabo, qui me conviendrait dans l'esprit, mais je
> n'arrive pas à l'adapter. voici le lien:http://excelabo.net/excel/compteclic.php?nom=mpfc-repertoires
> alors voila. ce classeur permet de lister les fichiers du type que l'on
> veut, dans le repertoire que l'on veut, en faisant des liens hypertextes, à
> partir d'un bouton de commande.
> moi, je voudrais un truc un peu plus simple, c'est à dire définir le type de
> fichier à *.*, et le répertoire au sous repertoire du fichier excel actif.
> je m'explique, je travail sous mon fichier tintin.xls. il se situe dans
> C:TESTMACHINBIDULE, donc moi je voudrais les fichiers *.* du dossier
> MACHIN et de tous ses sous-dossiers, sans demander l'avis de l'utilisateur.
>
> Petite particularité, mon bouton de commande se situe dans une barre d'outils.
>
> Est-ce possible selon vous ?
> et comment puis-je adapter ce classeur, selon vous ?
> Merci beaucoup.
> YANN




Sunburn
Le #18145381
OK,
Je te remercie, j'ai adapté ton code (la partie ou tu cherche le nouveau
chemin), à mon code, et ça fonctionne très bien.
par contre, puis-je le simplifier ou pas ?
y-a-t-il des bouts de code qui ne servent pas ? (je ne veux pas tout casser,
je prefere pas supprimer au cas où, ne sachant pas, mais si c'est pas utile,
je supprime)

Merci beaucoup.
YANN
----
'Les déclarations et la fonction getdirectory qui suivent
'permettent d'ouvrir une boite de dialogue de type "choix d'un dossier"
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String)
As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
Dim Dossier As String
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez un dossier de destination pour les sauvegardes."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & ""
Else
GetDirectory = ""
End If
End Function

Sub Repertorier()
ActiveWorkbook.Unprotect 'déprotection du classeur
'chemin du repertoire plus haut que le fichier actif
For i = Len(ActiveWorkbook.path) To 1 Step -1
If Mid(ActiveWorkbook.path, i, 1) = "" Then Chemin = _
Left(ActiveWorkbook.path, i): Exit For
Next
'active la feuille Liens pour y mettre les informations
Sheets("Liens").Visible = True
Sheets("Liens").Activate
Application.ScreenUpdating = False
ActiveSheet.Cells.ClearContents
With Sheets("Liens")
.[A1].Value = [DGA!A1].Value
.[A2].Value = [DGA!A2].Value
.[A3].Value = [DGA!A3].Value
.[B1].Value = [DGA!B1].Value
.[B2].Value = [DGA!B2].Value
.[B3].Value = [DGA!B3].Value
.[F1].Value = [DGA!F3].Value
.[F2].Value = [DGA!F4].Value
.[F3].Value = [DGA!F5].Value
.[G1].Value = [DGA!G3].Value
.[G2].Value = [DGA!G4].Value
.[G3].Value = [DGA!G5].Value
'Une méthode basique sans API pour lister les répertoires et
'sous-répertoires. Michel Pierron, MPFE 2002. Adaptation Flo Cabon sur une
idée de "mrik"
'* nRow = Ligne de départ
'* FolderName = Chemin du répertoire à lister
'* Suffix = Filtre optionnel des types de fichiers
'* SubDir = True pour étendre la liste aux sous-répertoires
End With
Dim LeMessage As String, LeRepertoire As String, Lextension As String
Dim Profondeur As VbMsgBoxResult
Dim nRow As Long

LeMessage = "Choisissez le dossier à analyser"
LeRepertoire = Chemin 'ThisWorkbook.path
Lextension = "*.pdf"
'Profondeur = MsgBox("Voulez vous analyser aussi les sous-répertoires ?",
vbYesNo, "Profondeur d'analyse")
nRow = 6
'If Profondeur = vbYes Then
truc = Lister(nRow, LeRepertoire, Lextension, True)
'Else
'truc = Lister(nRow, LeRepertoire, Lextension, False)
'End If
ActiveWorkbook.Protect Structure:=True ', Windows:=True 'protection du
classeur
End Sub

Function Lister(nRow&, FolderName$, Optional Suffix$ = "*.*", Optional
SubDir As Boolean = True)
Dim i As Long, x As Long, File As String, Folder As String, nbFolders() As
String
Cells(nRow, 1) = FolderName
Cells(nRow, 1).Font.Bold = True
If Not Right(FolderName, 1) = "" Then FolderName = FolderName & ""
File = Dir(FolderName & Suffix)

Do While Len(File) > 0
With ActiveSheet
.Hyperlinks.Add Anchor:=.Cells(nRow, 5), _
Address:=FolderName & File, _
TextToDisplay:=File
End With
nRow = nRow + 1
File = Dir
Loop

If Not SubDir Then Exit Function
x = 0
Folder = Dir(FolderName, vbDirectory)

Do While Folder > ""
If Folder If (GetAttr(FolderName & Folder) And vbDirectory) = vbDirectory Then x
= x + 1
End If
Folder = Dir
Loop

ReDim nbFolders(x + 1)
i = 1
nbFolders(i) = Dir(FolderName, vbDirectory)
Do While nbFolders(i) > ""
If nbFolders(i) If (GetAttr(FolderName & nbFolders(i)) And vbDirectory) = vbDirectory
Then i = i + 1
End If
nbFolders(i) = Dir
Loop
For i = 1 To UBound(nbFolders()) - 1
Call Lister(nRow, FolderName & nbFolders(i), Suffix)
Next
End Function
----------
JLuc
Le #18148361
Dans l'esprit de ce que t'a donné Jacky :

Sub test()
Chemin = Dir(ActiveWorkbook.Path & "..") '*A adapter
Do Until Chemin = ""
MsgBox Chemin
Chemin = Dir
Loop
End Sub
tu auras la liste des fichiers du dossier parent


Bonjour,

Liste les fichiers d'un répertoire défini
'-----------------------
Sub jj()
Chemin = dir("C:TESTMACHIN*.*") '*A adapter
Do Until Chemin = ""
MsgBox Chemin
Chemin = dir
Loop
End Sub
'-------------------------
--
Salutations
JJ


"Sunburn" news:
Bonjour,
j'ai trouvé un code sur excelabo, qui me conviendrait dans l'esprit, mais
je
n'arrive pas à l'adapter. voici le lien:
http://excelabo.net/excel/compteclic.php?nom=mpfc-repertoires
alors voila. ce classeur permet de lister les fichiers du type que l'on
veut, dans le repertoire que l'on veut, en faisant des liens hypertextes, à
partir d'un bouton de commande.
moi, je voudrais un truc un peu plus simple, c'est à dire définir le type
de
fichier à *.*, et le répertoire au sous repertoire du fichier excel actif.
je m'explique, je travail sous mon fichier tintin.xls. il se situe dans
C:TESTMACHINBIDULE, donc moi je voudrais les fichiers *.* du dossier
MACHIN et de tous ses sous-dossiers, sans demander l'avis de
l'utilisateur.

Petite particularité, mon bouton de commande se situe dans une barre
d'outils.

Est-ce possible selon vous ?
et comment puis-je adapter ce classeur, selon vous ?
Merci beaucoup.
YANN





Publicité
Poster une réponse
Anonyme