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
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
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
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
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
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
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 <> "." And Folder <> ".." Then
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) <> "." And nbFolders(i) <> ".." Then
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
------
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 <> "." And Folder <> ".." Then
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) <> "." And nbFolders(i) <> ".." Then
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
------
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 <> "." And Folder <> ".." Then
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) <> "." And nbFolders(i) <> ".." Then
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
------
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 wrote:
> 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
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 <Sunb...@discussions.microsoft.com> wrote:
> 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
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 wrote:
> 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
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" a écrit dans le message de
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
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" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: F7D4920B-A2D9-4342-A8D9-11F9AF226304@microsoft.com...
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
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" a écrit dans le message de
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