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

10 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
LSteph
Bonjour,

Excel classe les chaines de chr de gauche à droite et les nombres du
plus petit au plus grand.

ce que tu obtiens est donc dans le bon ordre.
> n 01 b.jpg
> n 1 b.jpg le 1 vient dans l'ordre alpha juste après le 0 au chr
> n 10 b.jpg la chaine 1 est donc avant la chaine 10
> n 11 b.jpg
> n 12 b.jpg
> n 2 b.jpg la chaine 2 supérieure aux chaines 1...
> n 20 b.jpg
> n 200 b.jpg
> n 25 b.jpg
> n 28 b.jpg
> n 3 b.jpg la chaine 3 supérieure aux chaines 2..
> n 32 b.jpg ...etc

L'ordre que tu as dans l'explorateur doit tenir à la date de création
ou autre
En tout état de cause c'est cette info que tu serais contraint de
récupèrer dans ta boucle en plus du nom pour les classer sans autre
changement.

ou plus simplement

En corrigeant légèrement la syntaxe de tes noms de fichiers!
(déjà éviter les espaces inutiles dans les noms de fichiers)
et rajouter les zéros utiles

n0001b
n0002b
n0010b
n0011b

...etc

Cordialement.

--
lSteph


Zebulion a écrit :
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



Avatar
Michel Angelosanto
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" №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
Avatar
Zebulion
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


Avatar
LSteph
.. je remets puisqu'objectivement tu ne vois pas!

Bonjour,

Excel classe les chaines de chr de gauche à droite et les nombres du
plus petit au plus grand.

ce que tu obtiens est donc dans le bon ordre.
> n 01 b.jpg
> n 1 b.jpg le 1 vient dans l'ordre alpha juste après le 0 au chr
> n 10 b.jpg la chaine 1 est donc avant la chaine 10
> n 11 b.jpg
> n 12 b.jpg
> n 2 b.jpg la chaine 2 supérieure aux chaines 1...
> n 20 b.jpg
> n 200 b.jpg
> n 25 b.jpg
> n 28 b.jpg
> n 3 b.jpg la chaine 3 supérieure aux chaines 2..
> n 32 b.jpg ...etc

L'ordre que tu as dans l'explorateur doit tenir à la date de création
ou autre
En tout état de cause c'est cette info que tu serais contraint de
récupèrer dans ta boucle en plus du nom pour les classer sans autre
changement.

ou plus simplement

En corrigeant légèrement la syntaxe de tes noms de fichiers!
(déjà éviter les espaces inutiles dans les noms de fichiers)
et rajouter les zéros utiles

n0001b
n0002b
n0010b
n0011b

...etc

Cordialement.

--
lSteph

Zebulion a écrit :
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





Avatar
Mishell
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
Zebulion
Bonsoir
Je me suis mal fait comprendre
Je savais depuis le début que c'était le tri sur la chaîne de caractère qui
posait "problème": voir mon "classique..." dans le post d'origine juste
avant mes questions.
En fait ce que je n'ai pas bien compris dans la réponse de Michel
Angelosanto, c'est comment utiliser la synthaxe
fichier="n " &droite("00" &numero;3) &" b.jpg"




qu'il m'a conseillé d'adopter.
J'ai essayé sous excel en format personnalisé ==> mauvaise pioche
J'ai cherché dans excel mais n'ai rien trouvé de probant pour le renommage
dans la valeur des cellules
Alors macro excel? Modif de la macro décrite ci-dessous? utilitaire de
renommage sous vista? ordre sous fenêtre dos?

Si vous avez une réponse, je suis preneur, d'autant plus que c'est
essentiellement pour quelqu'un de ma famille qui est un fou de photos et qui
est en trai de numériser 60 ans de photos négas et diapos. Il en est à plus
de 9000 et n'a numérisé que 5 ans d'historique...
Je ne vous raconte pas son envie d'avoir ses listes et de les imprimer...
Mon exemple est en fait surtout basé sur sa nomination de ses fichiers
Alors je cherche quelque chose de simple pour extraire la liste et pouvoir
la modifier à tout moment.
La macro jb-ArborescenceRepertoireLiens.xls est géniale pour cela, sauf ce
problème de tri des noms...

Merci d'avance
@+
Cordialement
Philippe

"LSteph" a écrit dans le message de
news:
.. je remets puisqu'objectivement tu ne vois pas!

Bonjour,

Excel classe les chaines de chr de gauche à droite et les nombres du plus
petit au plus grand.

ce que tu obtiens est donc dans le bon ordre.
> n 01 b.jpg
> n 1 b.jpg le 1 vient dans l'ordre alpha juste après le 0 au chr
> n 10 b.jpg la chaine 1 est donc avant la chaine 10
> n 11 b.jpg
> n 12 b.jpg
> n 2 b.jpg la chaine 2 supérieure aux chaines 1...
> n 20 b.jpg
> n 200 b.jpg
> n 25 b.jpg
> n 28 b.jpg
> n 3 b.jpg la chaine 3 supérieure aux chaines 2..
> n 32 b.jpg ...etc

L'ordre que tu as dans l'explorateur doit tenir à la date de création ou
autre
En tout état de cause c'est cette info que tu serais contraint de
récupèrer dans ta boucle en plus du nom pour les classer sans autre
changement.

ou plus simplement

En corrigeant légèrement la syntaxe de tes noms de fichiers!
(déjà éviter les espaces inutiles dans les noms de fichiers)
et rajouter les zéros utiles

n0001b
n0002b
n0010b
n0011b

...etc

Cordialement.

--
lSteph

Zebulion a écrit :
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







Avatar
Zebulion
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
MichDenis
Dans un module standard, copie cette fonction personnalisée :
Cette fonction requiert Excel 2000 ou plus récent.
'-------------------------------------------
Function Numéro(Rg As Range) As Long
Numéro = Val(Replace(Split(Rg, "n ") _
(UBound(Split(Rg, "n "))), "b.jpg", ""))
End Function
'-------------------------------------------
Et dans une colonne libre près de ta liste de fichiers, tu extraits
le numéro contenu dans le nom du fichier. Ce numéro sera
inscrit dans la cellule en tant que valeur numérique. En sélectionnant
toute la plage de cellule (pas seulement la colonne contenant la
valeur numérique) tu pourras faire un tri sur la colonne des valeurs
numériques. Tu auras à coup sûr, du plus petit au plus grand ou
l'inverse selon tes désirs.
Pour utiliser la fonction dans une cellule d'excel, tu saisis :
=Numéro(A1) A1 étant la cellule contenant le nom du fichier.



"Zebulion" <zebulion(enlever_ceci_cela)@free.fr> a écrit dans le message de groupe de
discussion :
Bonsoir
Je me suis mal fait comprendre
Je savais depuis le début que c'était le tri sur la chaîne de caractère qui
posait "problème": voir mon "classique..." dans le post d'origine juste
avant mes questions.
En fait ce que je n'ai pas bien compris dans la réponse de Michel
Angelosanto, c'est comment utiliser la synthaxe
fichier="n " &droite("00" &numero;3) &" b.jpg"




qu'il m'a conseillé d'adopter.
J'ai essayé sous excel en format personnalisé ==> mauvaise pioche
J'ai cherché dans excel mais n'ai rien trouvé de probant pour le renommage
dans la valeur des cellules
Alors macro excel? Modif de la macro décrite ci-dessous? utilitaire de
renommage sous vista? ordre sous fenêtre dos?

Si vous avez une réponse, je suis preneur, d'autant plus que c'est
essentiellement pour quelqu'un de ma famille qui est un fou de photos et qui
est en trai de numériser 60 ans de photos négas et diapos. Il en est à plus
de 9000 et n'a numérisé que 5 ans d'historique...
Je ne vous raconte pas son envie d'avoir ses listes et de les imprimer...
Mon exemple est en fait surtout basé sur sa nomination de ses fichiers
Alors je cherche quelque chose de simple pour extraire la liste et pouvoir
la modifier à tout moment.
La macro jb-ArborescenceRepertoireLiens.xls est géniale pour cela, sauf ce
problème de tri des noms...

Merci d'avance
@+
Cordialement
Philippe

"LSteph" a écrit dans le message de
news:
.. je remets puisqu'objectivement tu ne vois pas!

Bonjour,

Excel classe les chaines de chr de gauche à droite et les nombres du plus
petit au plus grand.

ce que tu obtiens est donc dans le bon ordre.
> n 01 b.jpg
> n 1 b.jpg le 1 vient dans l'ordre alpha juste après le 0 au chr
> n 10 b.jpg la chaine 1 est donc avant la chaine 10
> n 11 b.jpg
> n 12 b.jpg
> n 2 b.jpg la chaine 2 supérieure aux chaines 1...
> n 20 b.jpg
> n 200 b.jpg
> n 25 b.jpg
> n 28 b.jpg
> n 3 b.jpg la chaine 3 supérieure aux chaines 2..
> n 32 b.jpg ...etc

L'ordre que tu as dans l'explorateur doit tenir à la date de création ou
autre
En tout état de cause c'est cette info que tu serais contraint de
récupèrer dans ta boucle en plus du nom pour les classer sans autre
changement.

ou plus simplement

En corrigeant légèrement la syntaxe de tes noms de fichiers!
(déjà éviter les espaces inutiles dans les noms de fichiers)
et rajouter les zéros utiles

n0001b
n0002b
n0010b
n0011b

...etc

Cordialement.

--
lSteph

Zebulion a écrit :
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







Avatar
MichDenis
La macro suivante devrait faire le travail pour tous les fichiers
d'un répertoire : Tu copies tout ceci dans un module standar

Il ne te reste plus qu'à renseigner la variable répertoire .

'-------------------------------------------------------
Sub test()
Dim fichier As String, A As Integer
Dim Repertoire As String, Tblo(), Rg As Range
Repertoire = "C:UsersPowerUserDocuments" 'à renseigner
fichier = Dir(Repertoire & "*.jpg")
Application.ScreenUpdating = False
Do While fichier <> ""
ReDim Preserve Tblo(A)
Tblo(A) = Repertoire & fichier
A = A + 1
fichier = Dir()
Loop
Range("A1") = "Répertoire & fichiers"
Range("B1") = "Grosseur du fichier(octets)"
Range("C1") = "Date de modification du fichier"
Range("D1") = "Numéro de la photo"
With Range("A1:D1").Font
.Bold = True
.Name = "Arial"
.Color = vbRed
End With
Set Rg = Range("A2").Resize(UBound(Tblo) + 1)
Rg = Application.Transpose(Tblo)
Rg.Offset(, 1).Formula = "=Fichier_Size(" & Rg(1).Address(0, 0) & ")"
Rg.Offset(, 2).Formula = "Úte_Modification_Fichier(" & Rg(1).Address(0, 0) & ")"
Rg.Offset(, 2).NumberFormat = "DD/MM/YY H:MM:SS"
Rg.Offset(, 3).Formula = "=Numéro(" & Rg(1).Address(0, 0) & ")"
Rg.Offset(, 1).Resize(, 3).Value = Rg.Offset(, 1).Resize(, 3).Value
Rg.Offset(, 1).Resize(, 3).HorizontalAlignment = xlCenter
Rg.Resize(, 4).Sort key1:=Rg.Offset(, 3), order1:=xlAscending, Header:=xlNo
Rg.Resize(, 4).EntireColumn.AutoFit
End Sub
'-------------------------------------------------------
Function Fichier_Size(Rg As Range)
Fichier_Size = FileLen(Rg)
End Function
'-------------------------------------------------------
Function Date_Modification_Fichier(Rg As Range)
Date_Modification_Fichier = FileDateTime(Rg)
End Function
'-------------------------------------------------------
Function Numéro(Rg As Range) As Long
Numéro = Val(Replace(Split(Rg, "n ") _
(UBound(Split(Rg, "n "))), "b.jpg", ""))
End Function
'-------------------------------------------------------
Avatar
Mishell
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









1 2