Choix du niveau d'arborescence

Le
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
Questions / Réponses high-tech
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
Mgr T. Banni
Le #21246831
si, si, infogroup, je le vois à 7.34
sauf que si tu changes l'objet de la ficelle, tu vas te faire souffler dans les bronchies par ceux qui t'ont déjà apporté leur aide
Mgr T.B.

"Infogroup"
Mon post de ce matin qui faisait suite à celui d'hier n'a pas l'air d'avoir été envoyé,


michdenis
Le #21246821
Et ton problème, c'est ?

Je ne comprends pas ce que tu désires obtenir comme résultat!



"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
LSteph
Le #21247041
Bonjour,

On attendra donc le problème de demain qui sera lui plus variable que
celui de la veille qui aurait changé d'ici le jour même, donc avec un
choix du niveau de précision de la demande situé dans l'arborescence
d'une réponse possible avant que le fond de la question d'origine
n'ait été modifié.

Cordialement.

--
LSteph

On 22 fév, 14:11, "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


Daniel.C
Le #21247111
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


Daniel.C
Le #21247101
Au temps pour moi, je n'ai rien dit.
Daniel

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




Daniel.C
Le #21247241
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


Infogroup
Le #21247911
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" 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 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






Daniel.C
Le #21248081
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" 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 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








Infogroup
Le #21248531
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" 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.
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" 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 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












Daniel.C
Le #21248651
Surtout les autres... Je n'ai fait que greffer deux ou trois verrues.
;-)
Daniel

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" 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.
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" 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 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














Publicité
Poster une réponse
Anonyme