adaptation de jb-ArborescenceRepertoireLiens.xls pour trier ou non
Le
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 1 b.jpg"
"D:\pour test renommages 2 b.jpg"
"D:\pour test renommages 3 b.jpg"
"D:\pour test renommages 10 b.jpg"
"D:\pour test renommages 11 b.jpg"
"D:\pour test renommages 12 b.jpg"
"D:\pour test renommages 20 b.jpg"
"D:\pour test renommages 25 b.jpg"
"D:\pour test renommages 28 b.jpg"
"D:\pour test renommages 32 b.jpg"
"D:\pour test renommages 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
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 1 b.jpg"
"D:\pour test renommages 2 b.jpg"
"D:\pour test renommages 3 b.jpg"
"D:\pour test renommages 10 b.jpg"
"D:\pour test renommages 11 b.jpg"
"D:\pour test renommages 12 b.jpg"
"D:\pour test renommages 20 b.jpg"
"D:\pour test renommages 25 b.jpg"
"D:\pour test renommages 28 b.jpg"
"D:\pour test renommages 32 b.jpg"
"D:\pour test renommages 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
Poser une question
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 :
caractères par exemple ici sur 3 caractères
fichier="n " &droite("00" №3) &" b.jpg"
"Zebulion" news:
--
Michel Angelosanto, Bordeaux
Dernières mises à jour du site Voyage au pays Internet
http://angelosa.free.fr/index.php?t=8
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" news:
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 :
Voici une réponse partielle à la question 1
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" news: