Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir été envoyé,
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir été envoyé,
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir été envoyé,
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'a voir
été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2 etc...,
ceci étant définit par un choix du niveau de l'arborescence à parti r du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'a voir
été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2 etc...,
ceci étant définit par un choix du niveau de l'arborescence à parti r du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'a voir
été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2 etc...,
ceci étant définit par un choix du niveau de l'arborescence à parti r du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir
été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2 etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir
été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2 etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir
été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2 etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Bonjour.
Essaie la fonction de michdenis que je me suis permis de modifier. Cela vaut
pour las sous dossiers de niveau 1, si j'ai bien compris :
Function ListeDossiers(dossier, Liste())
Dim Fs As Object, F As Object
Dim F1 As Object, Sf As Object, A As Integer
Set Fs = CreateObject("Scripting.FileSystemObject")
Set F = Fs.GetFolder(dossier)
Set Sf = F.SubFolders
For Each F1 In Sf
Var = F1.parentfolder.Path
If LCase(F1.parentfolder.Path) = LCase(dossier) Then
ReDim Preserve Liste(0 To A)
Liste(A) = F1.Name
A = A + 1
End If
Next
ListeDossiers = Liste
Erase Liste
End Function
DanielMon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir
été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Bonjour.
Essaie la fonction de michdenis que je me suis permis de modifier. Cela vaut
pour las sous dossiers de niveau 1, si j'ai bien compris :
Function ListeDossiers(dossier, Liste())
Dim Fs As Object, F As Object
Dim F1 As Object, Sf As Object, A As Integer
Set Fs = CreateObject("Scripting.FileSystemObject")
Set F = Fs.GetFolder(dossier)
Set Sf = F.SubFolders
For Each F1 In Sf
Var = F1.parentfolder.Path
If LCase(F1.parentfolder.Path) = LCase(dossier) Then
ReDim Preserve Liste(0 To A)
Liste(A) = F1.Name
A = A + 1
End If
Next
ListeDossiers = Liste
Erase Liste
End Function
Daniel
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir
été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Bonjour.
Essaie la fonction de michdenis que je me suis permis de modifier. Cela vaut
pour las sous dossiers de niveau 1, si j'ai bien compris :
Function ListeDossiers(dossier, Liste())
Dim Fs As Object, F As Object
Dim F1 As Object, Sf As Object, A As Integer
Set Fs = CreateObject("Scripting.FileSystemObject")
Set F = Fs.GetFolder(dossier)
Set Sf = F.SubFolders
For Each F1 In Sf
Var = F1.parentfolder.Path
If LCase(F1.parentfolder.Path) = LCase(dossier) Then
ReDim Preserve Liste(0 To A)
Liste(A) = F1.Name
A = A + 1
End If
Next
ListeDossiers = Liste
Erase Liste
End Function
DanielMon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir
été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir
été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2 etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir
été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2 etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir
été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2 etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
J'espère avoir plus de chance avec le code de JB modifié.
Dans la macro :
Sub Lit_dossier(ByRef dossier, ByVal niveau)
j'ai mis :
If niveau > 3 Then Exit For
pour lister les dossiers jusqu'au niveau 2; modifier pour ne conserver que
les niveaux 1.
Daniel
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").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 = decal(niveau - 1) & dossier.Name & "[" & dossier.Path
& "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau > 3 Then Exit For
Lit_dossier d, niveau + 1
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End FunctionMon post de ce matin qui faisait suite à celui d'hier n'a pas l'air
d'avoir été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
J'espère avoir plus de chance avec le code de JB modifié.
Dans la macro :
Sub Lit_dossier(ByRef dossier, ByVal niveau)
j'ai mis :
If niveau > 3 Then Exit For
pour lister les dossiers jusqu'au niveau 2; modifier pour ne conserver que
les niveaux 1.
Daniel
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").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 = decal(niveau - 1) & dossier.Name & "[" & dossier.Path
& "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau > 3 Then Exit For
Lit_dossier d, niveau + 1
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air
d'avoir été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
J'espère avoir plus de chance avec le code de JB modifié.
Dans la macro :
Sub Lit_dossier(ByRef dossier, ByVal niveau)
j'ai mis :
If niveau > 3 Then Exit For
pour lister les dossiers jusqu'au niveau 2; modifier pour ne conserver que
les niveaux 1.
Daniel
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").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 = decal(niveau - 1) & dossier.Name & "[" & dossier.Path
& "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau > 3 Then Exit For
Lit_dossier d, niveau + 1
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End FunctionMon post de ce matin qui faisait suite à celui d'hier n'a pas l'air
d'avoir été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Bonjour Daniel.C et merci de te pencher à nouveau sur mon problème.
Je n'ai peut-être pas été assez clair, en effet, il ne s'agit pas de lister
des répertoires jusqu'au niveau 2 par exemple, mais de ne lister " que " les
répertoires du niveau 2 ou que les répertoires de niveau 3, ceci à partir
d'un répertoire Parent choisi dans la ligne racine = ChoixDossier() de la
proc. de JB
Merci à tous ceux qui ont déjà contribué à m'aider,
Cdl
Infogroup
"Daniel.C" a écrit dans le message de groupe de
discussion :J'espère avoir plus de chance avec le code de JB modifié.
Dans la macro :
Sub Lit_dossier(ByRef dossier, ByVal niveau)
j'ai mis :
If niveau > 3 Then Exit For
pour lister les dossiers jusqu'au niveau 2; modifier pour ne conserver que
les niveaux 1.
Daniel
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").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 = decal(niveau - 1) & dossier.Name & "[" & dossier.Path
& "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau > 3 Then Exit For
Lit_dossier d, niveau + 1
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End FunctionMon post de ce matin qui faisait suite à celui d'hier n'a pas l'air
d'avoir été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Bonjour Daniel.C et merci de te pencher à nouveau sur mon problème.
Je n'ai peut-être pas été assez clair, en effet, il ne s'agit pas de lister
des répertoires jusqu'au niveau 2 par exemple, mais de ne lister " que " les
répertoires du niveau 2 ou que les répertoires de niveau 3, ceci à partir
d'un répertoire Parent choisi dans la ligne racine = ChoixDossier() de la
proc. de JB
Merci à tous ceux qui ont déjà contribué à m'aider,
Cdl
Infogroup
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de groupe de
discussion : encNaI9sKHA.4636@TK2MSFTNGP06.phx.gbl...
J'espère avoir plus de chance avec le code de JB modifié.
Dans la macro :
Sub Lit_dossier(ByRef dossier, ByVal niveau)
j'ai mis :
If niveau > 3 Then Exit For
pour lister les dossiers jusqu'au niveau 2; modifier pour ne conserver que
les niveaux 1.
Daniel
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").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 = decal(niveau - 1) & dossier.Name & "[" & dossier.Path
& "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau > 3 Then Exit For
Lit_dossier d, niveau + 1
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air
d'avoir été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Bonjour Daniel.C et merci de te pencher à nouveau sur mon problème.
Je n'ai peut-être pas été assez clair, en effet, il ne s'agit pas de lister
des répertoires jusqu'au niveau 2 par exemple, mais de ne lister " que " les
répertoires du niveau 2 ou que les répertoires de niveau 3, ceci à partir
d'un répertoire Parent choisi dans la ligne racine = ChoixDossier() de la
proc. de JB
Merci à tous ceux qui ont déjà contribué à m'aider,
Cdl
Infogroup
"Daniel.C" a écrit dans le message de groupe de
discussion :J'espère avoir plus de chance avec le code de JB modifié.
Dans la macro :
Sub Lit_dossier(ByRef dossier, ByVal niveau)
j'ai mis :
If niveau > 3 Then Exit For
pour lister les dossiers jusqu'au niveau 2; modifier pour ne conserver que
les niveaux 1.
Daniel
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").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 = decal(niveau - 1) & dossier.Name & "[" & dossier.Path
& "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau > 3 Then Exit For
Lit_dossier d, niveau + 1
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End FunctionMon post de ce matin qui faisait suite à celui d'hier n'a pas l'air
d'avoir été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
lvl = CInt(InputBox("Entrez le niveau à lister"))
If Not IsNumeric(lvl) Then Exit Sub
Range("a:c").Clear
Range("a3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine, 1, lvl
Range("A:A").Resize(, lvl).Delete
Range("A1",
Range("A65536").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Select
End Sub
Sub Lit_dossier(ByRef dossier, ByRef niveau, lvl)
ActiveCell.Offset(, niveau - 1).Value = dossier.Name & "[" &
dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau <= lvl Then
Lit_dossier d, niveau + 1, lvl
End If
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
J'ai ajouté une inputbox demandant quel niveau lister. Apparemment, ça
fonctionne.
DanielBonjour Daniel.C et merci de te pencher à nouveau sur mon problème.
Je n'ai peut-être pas été assez clair, en effet, il ne s'agit pas de
lister des répertoires jusqu'au niveau 2 par exemple, mais de ne lister "
que " les répertoires du niveau 2 ou que les répertoires de niveau 3,
ceci à partir d'un répertoire Parent choisi dans la ligne racine =
ChoixDossier() de la proc. de JB
Merci à tous ceux qui ont déjà contribué à m'aider,
Cdl
Infogroup
"Daniel.C" a écrit dans le message de groupe
de discussion :J'espère avoir plus de chance avec le code de JB modifié.
Dans la macro :
Sub Lit_dossier(ByRef dossier, ByVal niveau)
j'ai mis :
If niveau > 3 Then Exit For
pour lister les dossiers jusqu'au niveau 2; modifier pour ne conserver
que les niveaux 1.
Daniel
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").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 = decal(niveau - 1) & dossier.Name & "[" &
dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau > 3 Then Exit For
Lit_dossier d, niveau + 1
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End FunctionMon post de ce matin qui faisait suite à celui d'hier n'a pas l'air
d'avoir été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
lvl = CInt(InputBox("Entrez le niveau à lister"))
If Not IsNumeric(lvl) Then Exit Sub
Range("a:c").Clear
Range("a3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine, 1, lvl
Range("A:A").Resize(, lvl).Delete
Range("A1",
Range("A65536").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Select
End Sub
Sub Lit_dossier(ByRef dossier, ByRef niveau, lvl)
ActiveCell.Offset(, niveau - 1).Value = dossier.Name & "[" &
dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau <= lvl Then
Lit_dossier d, niveau + 1, lvl
End If
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
J'ai ajouté une inputbox demandant quel niveau lister. Apparemment, ça
fonctionne.
Daniel
Bonjour Daniel.C et merci de te pencher à nouveau sur mon problème.
Je n'ai peut-être pas été assez clair, en effet, il ne s'agit pas de
lister des répertoires jusqu'au niveau 2 par exemple, mais de ne lister "
que " les répertoires du niveau 2 ou que les répertoires de niveau 3,
ceci à partir d'un répertoire Parent choisi dans la ligne racine =
ChoixDossier() de la proc. de JB
Merci à tous ceux qui ont déjà contribué à m'aider,
Cdl
Infogroup
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de groupe
de discussion : encNaI9sKHA.4636@TK2MSFTNGP06.phx.gbl...
J'espère avoir plus de chance avec le code de JB modifié.
Dans la macro :
Sub Lit_dossier(ByRef dossier, ByVal niveau)
j'ai mis :
If niveau > 3 Then Exit For
pour lister les dossiers jusqu'au niveau 2; modifier pour ne conserver
que les niveaux 1.
Daniel
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").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 = decal(niveau - 1) & dossier.Name & "[" &
dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau > 3 Then Exit For
Lit_dossier d, niveau + 1
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air
d'avoir été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
lvl = CInt(InputBox("Entrez le niveau à lister"))
If Not IsNumeric(lvl) Then Exit Sub
Range("a:c").Clear
Range("a3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine, 1, lvl
Range("A:A").Resize(, lvl).Delete
Range("A1",
Range("A65536").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Select
End Sub
Sub Lit_dossier(ByRef dossier, ByRef niveau, lvl)
ActiveCell.Offset(, niveau - 1).Value = dossier.Name & "[" &
dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau <= lvl Then
Lit_dossier d, niveau + 1, lvl
End If
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
J'ai ajouté une inputbox demandant quel niveau lister. Apparemment, ça
fonctionne.
DanielBonjour Daniel.C et merci de te pencher à nouveau sur mon problème.
Je n'ai peut-être pas été assez clair, en effet, il ne s'agit pas de
lister des répertoires jusqu'au niveau 2 par exemple, mais de ne lister "
que " les répertoires du niveau 2 ou que les répertoires de niveau 3,
ceci à partir d'un répertoire Parent choisi dans la ligne racine =
ChoixDossier() de la proc. de JB
Merci à tous ceux qui ont déjà contribué à m'aider,
Cdl
Infogroup
"Daniel.C" a écrit dans le message de groupe
de discussion :J'espère avoir plus de chance avec le code de JB modifié.
Dans la macro :
Sub Lit_dossier(ByRef dossier, ByVal niveau)
j'ai mis :
If niveau > 3 Then Exit For
pour lister les dossiers jusqu'au niveau 2; modifier pour ne conserver
que les niveaux 1.
Daniel
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").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 = decal(niveau - 1) & dossier.Name & "[" &
dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau > 3 Then Exit For
Lit_dossier d, niveau + 1
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End FunctionMon post de ce matin qui faisait suite à celui d'hier n'a pas l'air
d'avoir été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
C'est super, merci Daniel.C, ça fonctionne comme je le souhaitais.
Merci encore à toi sans oublier tous les autres contributeurs.
Cdl
Infogroup
"Daniel.C" a écrit dans le message de groupe de
discussion : uY3etT#Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
lvl = CInt(InputBox("Entrez le niveau à lister"))
If Not IsNumeric(lvl) Then Exit Sub
Range("a:c").Clear
Range("a3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine, 1, lvl
Range("A:A").Resize(, lvl).Delete
Range("A1",
Range("A65536").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Select
End Sub
Sub Lit_dossier(ByRef dossier, ByRef niveau, lvl)
ActiveCell.Offset(, niveau - 1).Value = dossier.Name & "[" & dossier.Path
& "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau <= lvl Then
Lit_dossier d, niveau + 1, lvl
End If
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
J'ai ajouté une inputbox demandant quel niveau lister. Apparemment, ça
fonctionne.
DanielBonjour Daniel.C et merci de te pencher à nouveau sur mon problème.
Je n'ai peut-être pas été assez clair, en effet, il ne s'agit pas de
lister des répertoires jusqu'au niveau 2 par exemple, mais de ne lister "
que " les répertoires du niveau 2 ou que les répertoires de niveau 3, ceci
à partir d'un répertoire Parent choisi dans la ligne racine =
ChoixDossier() de la proc. de JB
Merci à tous ceux qui ont déjà contribué à m'aider,
Cdl
Infogroup
"Daniel.C" a écrit dans le message de groupe de
discussion :J'espère avoir plus de chance avec le code de JB modifié.
Dans la macro :
Sub Lit_dossier(ByRef dossier, ByVal niveau)
j'ai mis :
If niveau > 3 Then Exit For
pour lister les dossiers jusqu'au niveau 2; modifier pour ne conserver
que les niveaux 1.
Daniel
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").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 = decal(niveau - 1) & dossier.Name & "[" &
dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau > 3 Then Exit For
Lit_dossier d, niveau + 1
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End FunctionMon post de ce matin qui faisait suite à celui d'hier n'a pas l'air
d'avoir été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
C'est super, merci Daniel.C, ça fonctionne comme je le souhaitais.
Merci encore à toi sans oublier tous les autres contributeurs.
Cdl
Infogroup
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de groupe de
discussion : uY3etT#sKHA.3660@TK2MSFTNGP05.phx.gbl...
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
lvl = CInt(InputBox("Entrez le niveau à lister"))
If Not IsNumeric(lvl) Then Exit Sub
Range("a:c").Clear
Range("a3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine, 1, lvl
Range("A:A").Resize(, lvl).Delete
Range("A1",
Range("A65536").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Select
End Sub
Sub Lit_dossier(ByRef dossier, ByRef niveau, lvl)
ActiveCell.Offset(, niveau - 1).Value = dossier.Name & "[" & dossier.Path
& "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau <= lvl Then
Lit_dossier d, niveau + 1, lvl
End If
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
J'ai ajouté une inputbox demandant quel niveau lister. Apparemment, ça
fonctionne.
Daniel
Bonjour Daniel.C et merci de te pencher à nouveau sur mon problème.
Je n'ai peut-être pas été assez clair, en effet, il ne s'agit pas de
lister des répertoires jusqu'au niveau 2 par exemple, mais de ne lister "
que " les répertoires du niveau 2 ou que les répertoires de niveau 3, ceci
à partir d'un répertoire Parent choisi dans la ligne racine =
ChoixDossier() de la proc. de JB
Merci à tous ceux qui ont déjà contribué à m'aider,
Cdl
Infogroup
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de groupe de
discussion : encNaI9sKHA.4636@TK2MSFTNGP06.phx.gbl...
J'espère avoir plus de chance avec le code de JB modifié.
Dans la macro :
Sub Lit_dossier(ByRef dossier, ByVal niveau)
j'ai mis :
If niveau > 3 Then Exit For
pour lister les dossiers jusqu'au niveau 2; modifier pour ne conserver
que les niveaux 1.
Daniel
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").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 = decal(niveau - 1) & dossier.Name & "[" &
dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau > 3 Then Exit For
Lit_dossier d, niveau + 1
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air
d'avoir été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup
C'est super, merci Daniel.C, ça fonctionne comme je le souhaitais.
Merci encore à toi sans oublier tous les autres contributeurs.
Cdl
Infogroup
"Daniel.C" a écrit dans le message de groupe de
discussion : uY3etT#Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
lvl = CInt(InputBox("Entrez le niveau à lister"))
If Not IsNumeric(lvl) Then Exit Sub
Range("a:c").Clear
Range("a3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
Lit_dossier dossier_racine, 1, lvl
Range("A:A").Resize(, lvl).Delete
Range("A1",
Range("A65536").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Select
End Sub
Sub Lit_dossier(ByRef dossier, ByRef niveau, lvl)
ActiveCell.Offset(, niveau - 1).Value = dossier.Name & "[" & dossier.Path
& "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau <= lvl Then
Lit_dossier d, niveau + 1, lvl
End If
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
J'ai ajouté une inputbox demandant quel niveau lister. Apparemment, ça
fonctionne.
DanielBonjour Daniel.C et merci de te pencher à nouveau sur mon problème.
Je n'ai peut-être pas été assez clair, en effet, il ne s'agit pas de
lister des répertoires jusqu'au niveau 2 par exemple, mais de ne lister "
que " les répertoires du niveau 2 ou que les répertoires de niveau 3, ceci
à partir d'un répertoire Parent choisi dans la ligne racine =
ChoixDossier() de la proc. de JB
Merci à tous ceux qui ont déjà contribué à m'aider,
Cdl
Infogroup
"Daniel.C" a écrit dans le message de groupe de
discussion :J'espère avoir plus de chance avec le code de JB modifié.
Dans la macro :
Sub Lit_dossier(ByRef dossier, ByVal niveau)
j'ai mis :
If niveau > 3 Then Exit For
pour lister les dossiers jusqu'au niveau 2; modifier pour ne conserver
que les niveaux 1.
Daniel
Sub arborescence()
racine = ChoixDossier() ' ou un répertoire C:xxx e.g.
If racine = "" Then Exit Sub
Range("a:c").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 = decal(niveau - 1) & dossier.Name & "[" &
dossier.Path & "]"
ActiveCell.Interior.ColorIndex = 36
ActiveCell.Offset(1, 0).Select
For Each d In dossier.SubFolders
If niveau > 3 Then Exit For
Lit_dossier d, niveau + 1
Next
End Sub
Function decal(niv)
decal = String(3 * niv, " ")
End Function
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End FunctionMon post de ce matin qui faisait suite à celui d'hier n'a pas l'air
d'avoir été envoyé, je disais donc :
Merci à michdenis et JB, mais j'ai encore un petit souci,
en effet, ma demande à l'origine était de pouvoir ne lister que les
sous-répertoires de niveau 1 ou que les sous-répertoires de niveau 2
etc...,
ceci étant définit par un choix du niveau de l'arborescence à partir du
répertoire de base.
Merci encore par avance
Cdl
Infogroup