Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel adaptation de jb-ArborescenceRepertoireLiens.xls pour trier ou non

adaptation de jb-ArborescenceRepertoireLiens.xls pour trier ou non

12 réponses
Avatar
Zebulion
Bonjour à toutes et tous.
Dernièrement j'avais demandé comment lister le contenu d'un répertoire et
vous m'avez conseillé jb-ArborescenceRepertoireLiens.xls .
Cest génial.
Cependant je voudrais savoir comment améliorer la présentation des fichiers,
en particulier concernant le tri des noms de fichiers.
En effet, je m'occupe de fichiers photos et le tri actuellement proposé dans
la macro jb-ArborescenceRepertoireLiens.xls me pose pb, par exemple:
"D:\pour test renommages\n 1 b.jpg"
"D:\pour test renommages\n 2 b.jpg"
"D:\pour test renommages\n 3 b.jpg"
"D:\pour test renommages\n 10 b.jpg"
"D:\pour test renommages\n 11 b.jpg"
"D:\pour test renommages\n 12 b.jpg"
"D:\pour test renommages\n 20 b.jpg"
"D:\pour test renommages\n 25 b.jpg"
"D:\pour test renommages\n 28 b.jpg"
"D:\pour test renommages\n 32 b.jpg"
"D:\pour test renommages\n 200 b.jpg"

Résultat dans excel après la macro:
n 01 b.jpg
n 1 b.jpg
n 10 b.jpg
n 11 b.jpg
n 12 b.jpg
n 2 b.jpg
n 20 b.jpg
n 200 b.jpg
n 25 b.jpg
n 28 b.jpg
n 3 b.jpg
n 32 b.jpg

Classique...

Alors questions:
1) comment faire en sorte qu'il n'y ait pas ce tri ?
Comment conserver l'ordre de l'explorateur de Vista?

Ci-dessous copie de ce qui existe dans jb-ArborescenceRepertoireLiens.xls

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
Lit_dossier d, niveau + 1
Next
For Each f In dossier.Files
nom_fich = f.Name
' ActiveCell.Value = decal(niveau) & f.Name & "* " & f.Size & " : " &
f.DateLastModified
ActiveCell = decal(niveau) & f.Name
ActiveCell.Offset(0, 1) = f.Size
ActiveCell.Offset(0, 2) = f.DateLastModified
ActiveCell.Interior.ColorIndex = 2
ActiveCell.Offset(1, 0).Select
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

Le tri s'effectue-t-il grâce à ActiveCell = decal(niveau) & f.Name ?


2) Peux-t-on facilement par contre introduire un tri, par exemple sur la
taille en posant la question?

3) il n'y a actuellement que 3 éléments extraits si je comprend bien.
' ActiveCell.Value = decal(niveau) & f.Name & "* " & f.Size & " : " &
f.DateLastModified
ActiveCell = decal(niveau) & f.Name
ActiveCell.Offset(0, 1) = f.Size
ActiveCell.Offset(0, 2) = f.DateLastModified

Comment trouver la liste des éléments (en angais apparamment) des éléments
récupérables et même cerise sur la macro comment en faire effectuer le choix
dans une liste ?

Merci d'avance pour votre aide

--
@+
Cordialement
Philippe
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Zebulion
Merci
Philippe
"Mishell" a écrit dans le message de
news:
Voici le lien vers le fichier sur cjoint.com:
http://cjoint.com/?dlb3DtPbo3


"Zebulion" <zebulion(enlever_ceci_cela)@free.fr> wrote in message
news:%
Merci
Je vais essayer ça tout à l'heure

Cordialement
Philippe

"Mishell" a écrit dans le message de
news:%
Bonjour.

Voici une réponse partielle à la question 1
Comment conserver l'ordre de l'explorateur de Vista


Ceci corrige le tri des fichiers, mais pas des répertoires :

Mishell

Sub arborescence()
racine = "C:aaaabb" ' ChoixDossier() ' ou un répertoire C:xxx
e.g.
If racine = "" Then Exit Sub
Range("a:g").Clear
Range("a3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
IndiceDuRepertoire = 0
Lit_dossier dossier_racine, 1
Range("A1").Select
Call classer
Range("g:g").Clear
End Sub

Sub classer()

derniereligne& = ActiveSheet.Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

For i = 4 To derniereligne

'Cells(i, 1).Select
If Cells(i, 1).Interior.ColorIndex <> 36 Then
fin = i
If debut = 0 Then
debut = i
End If
Else

fin = i - 1
If debut > 0 Then
If fin > debut Then
Call classerCesLignes(debut, fin)
End If
End If
debut = 0
End If
Next

If debut > 0 Then
If fin > debut Then
Call classerCesLignes(debut, fin)
End If
End If

End Sub

Sub classerCesLignes(debut, fin)

Set r = Range("a" & debut & ":" & "H" & fin)


r.Sort Key1:=Range("g4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom

End Sub

Sub Lit_dossier(ByRef dossier, ByVal niveau)
IndiceDuRepertoire = IndiceDuRepertoire + 1
ActiveCell.Value = decal(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 = decal(niveau) & f.Name
ActiveCell.Offset(0, 1) = f.Size
ActiveCell.Offset(0, 2) = f.DateLastModified
ActiveCell.Interior.ColorIndex = 2

a = modifieNombreDansFichier(nom_fich)
ActiveCell.Offset(0, 6) = a

ActiveCell.Offset(1, 0).Select
Next
For Each D In dossier.SubFolders
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
Function modifieNombreDansFichier(a)


LongueurDesireePourLeNombre = "000000000000000"

debut = 0
mot = ""
For i = 1 To Len(a)
D = Mid(a, i, 1)
If InStr("0123456789", D) > 0 Then

If debut = 0 Then
debut = i
fin = i
Else
fin = i
End If

Else
If debut > 0 Then
nombre = Mid(a, debut, fin - debut + 1)

zero = Mid(LongueurDesireePourLeNombre, 1,
Len(LongueurDesireePourLeNombre) - Len(nombre))

mot = mot & zero & nombre & D

debut = 0

Else

mot = mot & D
End If
End If

Next
If debut > 0 Then
nombre = Mid(a, debut, fin - debut + 1)

zero = Mid(LongueurDesireePourLeNombre, 1,
Len(LongueurDesireePourLeNombre) - Len(nombre))

mot = mot & zero & nombre
End If
modifieNombreDansFichier = mot

End Function


"Zebulion" <zebulion(enlever_ceci_cela)@free.fr> wrote in message
news:
Bonjour à toutes et tous.
Dernièrement j'avais demandé comment lister le contenu d'un répertoire
et vous m'avez conseillé jb-ArborescenceRepertoireLiens.xls .
Cest génial.
Cependant je voudrais savoir comment améliorer la présentation des
fichiers, en particulier concernant le tri des noms de fichiers.
En effet, je m'occupe de fichiers photos et le tri actuellement proposé
dans la macro jb-ArborescenceRepertoireLiens.xls me pose pb, par
exemple:
"D:pour test renommagesn 1 b.jpg"
"D:pour test renommagesn 2 b.jpg"
"D:pour test renommagesn 3 b.jpg"
"D:pour test renommagesn 10 b.jpg"
"D:pour test renommagesn 11 b.jpg"
"D:pour test renommagesn 12 b.jpg"
"D:pour test renommagesn 20 b.jpg"
"D:pour test renommagesn 25 b.jpg"
"D:pour test renommagesn 28 b.jpg"
"D:pour test renommagesn 32 b.jpg"
"D:pour test renommagesn 200 b.jpg"

Résultat dans excel après la macro:
n 01 b.jpg
n 1 b.jpg
n 10 b.jpg
n 11 b.jpg
n 12 b.jpg
n 2 b.jpg
n 20 b.jpg
n 200 b.jpg
n 25 b.jpg
n 28 b.jpg
n 3 b.jpg
n 32 b.jpg

Classique...

Alors questions:
1) comment faire en sorte qu'il n'y ait pas ce tri ?
Comment conserver l'ordre de l'explorateur de Vista?

Ci-dessous copie de ce qui existe dans
jb-ArborescenceRepertoireLiens.xls

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
Lit_dossier d, niveau + 1
Next
For Each f In dossier.Files
nom_fich = f.Name
' ActiveCell.Value = decal(niveau) & f.Name & "* " & f.Size & " : "
& f.DateLastModified
ActiveCell = decal(niveau) & f.Name
ActiveCell.Offset(0, 1) = f.Size
ActiveCell.Offset(0, 2) = f.DateLastModified
ActiveCell.Interior.ColorIndex = 2
ActiveCell.Offset(1, 0).Select
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

Le tri s'effectue-t-il grâce à ActiveCell = decal(niveau) & f.Name ?


2) Peux-t-on facilement par contre introduire un tri, par exemple sur
la taille en posant la question?

3) il n'y a actuellement que 3 éléments extraits si je comprend bien.
' ActiveCell.Value = decal(niveau) & f.Name & "* " & f.Size & " : " &
f.DateLastModified
ActiveCell = decal(niveau) & f.Name
ActiveCell.Offset(0, 1) = f.Size
ActiveCell.Offset(0, 2) = f.DateLastModified

Comment trouver la liste des éléments (en angais apparamment) des
éléments récupérables et même cerise sur la macro comment en faire
effectuer le choix dans une liste ?

Merci d'avance pour votre aide

--
@+
Cordialement
Philippe













Avatar
Mishell
Le renommage est une excellente façon de contrôler l'ordre du tri.
Exemple: changer le format de tous les nombres qui apparaissent dans les
noms de fichiers:
Ainsi
D:pour test renommagesn 1 b.jpg
deviendrait
D:pour test renommagesn 0001 b.jpg

Il est facile de renommer automatiquement tous les fichiers avec VBA.

Mishell


"Zebulion" <zebulion(enlever_ceci_cela)@free.fr> wrote in message
news:
Bonjour
C'est à dire qu'il faut intégrer cela dans la macro?
A quel endroit?
En créer une autre?
Effectuer un renommage sous fenêtre dos?
Dans Excel 2007 on n'a plus "Fichier" puisque tout est réorganisé comme
"intuitif" (parait-il...)
J'avoue ne pas comprendre où intervenir et ça me gratouille car cette
manip est "quotidienne" sur gros système, mais là je sèche!

Merci d'avance pour vos lumières
@++
Cordialement
Philippe

"Michel Angelosanto" a écrit dans le message de
news:
pour résoudre ce problème, il faut mettre les numéros sur le même nombre
de caractères par exemple ici sur 3 caractères
fichier="n " &droite("00" &numero;3) &" b.jpg"

"Zebulion" <zebulion(enlever_ceci_cela)@free.fr> a écrit dans le message
de news:
Bonjour à toutes et tous.
Dernièrement j'avais demandé comment lister le contenu d'un répertoire
et vous m'avez conseillé jb-ArborescenceRepertoireLiens.xls .
Cest génial.
Cependant je voudrais savoir comment améliorer la présentation des
fichiers, en particulier concernant le tri des noms de fichiers.
En effet, je m'occupe de fichiers photos et le tri actuellement proposé
dans la macro jb-ArborescenceRepertoireLiens.xls me pose pb, par
exemple:
"D:pour test renommagesn 1 b.jpg"
"D:pour test renommagesn 2 b.jpg"
"D:pour test renommagesn 3 b.jpg"
"D:pour test renommagesn 10 b.jpg"
"D:pour test renommagesn 11 b.jpg"
"D:pour test renommagesn 12 b.jpg"
"D:pour test renommagesn 20 b.jpg"
"D:pour test renommagesn 25 b.jpg"
"D:pour test renommagesn 28 b.jpg"
"D:pour test renommagesn 32 b.jpg"
"D:pour test renommagesn 200 b.jpg"

Résultat dans excel après la macro:
n 01 b.jpg
n 1 b.jpg
n 10 b.jpg
n 11 b.jpg
n 12 b.jpg
n 2 b.jpg
n 20 b.jpg
n 200 b.jpg
n 25 b.jpg
n 28 b.jpg
n 3 b.jpg
n 32 b.jpg

Classique...

Alors questions:
1) comment faire en sorte qu'il n'y ait pas ce tri ?
Comment conserver l'ordre de l'explorateur de Vista?

Ci-dessous copie de ce qui existe dans
jb-ArborescenceRepertoireLiens.xls

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
Lit_dossier d, niveau + 1
Next
For Each f In dossier.Files
nom_fich = f.Name
' ActiveCell.Value = decal(niveau) & f.Name & "* " & f.Size & " : " &
f.DateLastModified
ActiveCell = decal(niveau) & f.Name
ActiveCell.Offset(0, 1) = f.Size
ActiveCell.Offset(0, 2) = f.DateLastModified
ActiveCell.Interior.ColorIndex = 2
ActiveCell.Offset(1, 0).Select
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

Le tri s'effectue-t-il grâce à ActiveCell = decal(niveau) & f.Name ?


2) Peux-t-on facilement par contre introduire un tri, par exemple sur la
taille en posant la question?

3) il n'y a actuellement que 3 éléments extraits si je comprend bien.
' ActiveCell.Value = decal(niveau) & f.Name & "* " & f.Size & " : " &
f.DateLastModified
ActiveCell = decal(niveau) & f.Name
ActiveCell.Offset(0, 1) = f.Size
ActiveCell.Offset(0, 2) = f.DateLastModified

Comment trouver la liste des éléments (en angais apparamment) des
éléments récupérables et même cerise sur la macro comment en faire
effectuer le choix dans une liste ?

Merci d'avance pour votre aide

--
@+
Cordialement
Philippe



--
Michel Angelosanto, Bordeaux
Dernières mises à jour du site Voyage au pays Internet
http://angelosa.free.fr/index.php?t=8





1 2