C'est une requête un peu bizarre, mais j'ai malheureusement pas le choix : je cherche un soft qui copierait tous les fichiers d'un répertoire vers un autre, en procédant aléatoirement.
 
Je sais que ça a l'air complètement crétin/noob comme demande, mais voilà la raison : j'ai un cadre photo numérique qui prend une SD-card. J'ai préparé les photos à mettre dans mon cadre en parcourant tous mes répertoires de photos, et en copiant/collant les photos que je voulais à un endroit unique, avant de les passer en une fois sur la carte SD.
 
Le problème, c'est que mon cadre photo ne lit pas la SD de manière aléatoire, mais dans l'ordre dans lequel les fichiers ont été copiés sur la carte. C'est complètement débile, mais c'est comme ça (marqué en toutes lettres dans le manuel : Kodak SV811). Je me retrouve donc avec un visionnage pas du tout aléatoire, mais plutôt :
 
- ma première gosse dans sa première année
- ma première gosse dans sa deuxième année
[...]
- ma deuxième gosse dans sa première année
- ma deuxième gosse dans sa deuxième année
[...]
 
Bref, ça manque un peu de spontanéité. Je n'ai donc pas d'autre choix, si je veux que le diaporama soit un minimum pseudo-aléatoire, que de copier dans le désordre les fichiers JPG de mon répertoire source vers ma SD. A ma connaissance c'est une requête tellement n'importe quoi que j'ai rien trouvé qui fasse ça, mais il se peut que je me trompe. Donc si quelqu'un connaissait un soft qui fait ça, ça m'arrangerait.
 
(désolé pour l'explication un peu longue, mais comme je suis conscient que cette demande est un peu surréaliste, je voulais être sûr de pas passer pour un gros noob)

Bonjour,
as-tu excel?
si oui : un classement aléatoire qui peut te servir:
 
Sub rara()
upperbo = Sheets("feuil1" ).Cells(65527, 1).End(xlUp).Row
lowerbound = 1
For i = 1 To upperbo
upperbound = Sheets("feuil1" ).Cells(65527, 1).End(xlUp).Row
lili = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
Cells(i, 2) = Cells(lili, 1)
 Cells(lili, 1).Select
    Selection.Delete shift:=xlUp
Next i
Range("a:a" ).Select
Selection.Delete shift:=xlLeft
 
End Sub
Tu trouves sur la forum des réponses à la question: liste des fichiers d'un dossier. Tu places la liste dans colonne 1, tu lances rara, tu écris les fichiers dans l'ordre .
Je n'ai pas le courage ce matin de regrouper l'ensemble en un truc fini.
Cordialement

Re,
Un complet à tester:
Sub rara()
 
Set fs = Application.FileSearch
dossier = "n:\chouchou"
dossierarr = "n:\aleachouchou\"
fichs = "*.jpg"
Loogu = Len(dossier)
With fs
    .LookIn = dossier
    .Filename = fichs
    If .Execute(SortBy:=msoSortByFileName, _
    SortOrder:=msoSortOrderAscending) > 0 Then
        MsgBox "There were " & .FoundFiles.Count & _
            " file(s) found."
            Range("a:a" ).Select
            Selection.ClearContents
        For i = 1 To .FoundFiles.Count
        fname = Mid(.FoundFiles(i), Loogu + 2, Len(.FoundFiles(i)) - Len(Loogu))
            Cells(i, 1) = fname
        Next i
    Else
        MsgBox "There were no files found."
    End If
End With
upperbo = Sheets("feuil1" ).Cells(65527, 1).End(xlUp).Row
lowerbound = 1
For i = 1 To upperbo
upperbound = Sheets("feuil1" ).Cells(65527, 1).End(xlUp).Row
lili = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
Cells(i, 2) = Cells(lili, 1)
 Cells(lili, 1).Select
    Selection.Delete shift:=xlUp
Next i
Range("a:a" ).Select
Selection.Delete shift:=xlLeft
dossierdep = dossier & "\"
 
Kill dossierarr & "*.jpg"
For i = 1 To upperbo
fichacop = dossierdep & Cells(i, 1)
fichar = dossierarr & "a" & i & Cells(i, 1)
FileCopy fichacop, fichar
Next i
End Sub
Si tu veux des précisions n'hésite pas
Cordialement

J'avoue que j'aurais pas eu l'idée de le faire en Excel, mais c'est vrai que c'est pas bête, vu la petite opération à effectuer
 
Y'a une petite crotte, il tronque la première lettre de chaque fichier donc la copie plante, mais je jette un oeil (j'y connais rien en VBA mais bon, je suis développeur donc je devrais m'en sortir)
Aussi, il tente de supprimer du répertoire destination, mais si le fichier existe pas il plante au lieu de ne rien dire => j'efface moi même, et j'ai commenté la ligne
 
Quoi qu'il en soit, merci pour ce petit bout de code qui fait (fera) pile-poil ce que je veux
 
EDIT : ca marche, encore merci

Re,
passe nous ta mouture finale cela peut nous aider
Merci
cordialement

Voila mes modifs ... moi je suis plutot Java, donc VBA je connais pas et j'ai fait ça à l'arrache, donc c'est pas très beau mais ça marche.
 
Sinon, j'ai quand même envoyé un commentaire à Kodak, parce que faut pas déconner non plus, même pas de lecture aléatoire dans un cadre photo numérique, c'est franchement n'importe quoi
 
Encore merci
 
Private Sub CommandButton1_Click()
 
Set fs = Application.FileSearch
dossier = "d:\temp\copytest\src\"
dossierarr = "d:\temp\copytest\dst\"
fichs = "*.jpg"
Loogu = Len(dossier)
With fs
    .LookIn = dossier
    .Filename = fichs
    If .Execute(SortBy:=msoSortByFileName, _
    SortOrder:=msoSortOrderAscending) > 0 Then
        MsgBox "There were " & .FoundFiles.Count & _
            " file(s) found."
            Range("a:a" ).Select
            Selection.ClearContents
        For i = 1 To .FoundFiles.Count
        ' y avait un petit bug dans le substring qui tronquait le premier caractere du nom
 
        fname = Mid(.FoundFiles(i), Loogu + 1, Len(.FoundFiles(i)) - Len(Loogu))
            Cells(i, 1) = fname
        Next i
    Else
        MsgBox "There were no files found."
    End If
End With
upperbo = Sheets("First" ).Cells(65527, 1).End(xlUp).Row
lowerbound = 1
For i = 1 To upperbo
upperbound = Sheets("First" ).Cells(65527, 1).End(xlUp).Row
lili = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
Cells(i, 2) = Cells(lili, 1)
 Cells(lili, 1).Select
    Selection.Delete shift:=xlUp
Next i
Range("a:a" ).Select
Selection.Delete shift:=xlLeft
dossierdep = dossier & "\"
 
' je supprime l effacement de la destination, ca plante quand c est vide et je sais pas l empecher
 
' Kill dossierarr & "*.jpg"
For i = 1 To upperbo
 
' je rajoute des 0 pour conserver l ordre lexicograhique. C est fait de manière degueu mais je connais pas VBA
prefix = "a"
 
If i < 1000 Then
    prefix = prefix & "0"
End If
 
If i < 100 Then
    prefix = prefix & "0"
End If
 
If i < 10 Then
    prefix = prefix & "0"
End If

fichacop = dossierdep & Cells(i, 1)
fichar = dossierarr & prefix & i & "_" & Cells(i, 1)
'fichar = dossierarr & Cells(i, 1)
FileCopy fichacop, fichar
Next i
End Sub

Re,
J'ai essayé de tenir compte de tes améliorations  
A noter, la numérotation n'est peut-être pas indispensable si ton Kodak 811 prend dans l'ordre d'écriture et no dans l'ordre alphabétique
 
Private Sub CommandButton1_Click()  
 
Set fs = Application.FileSearch
dossier = "d:\temp\copytest\src\"  
dossierarr = "d:\temp\copytest\dst\"  
fichs = "*.jpg"
Loogu = Len(dossier)
With fs
    .LookIn = dossier
    .Filename = fichs
    If .Execute(SortBy:=msoSortByFileName, _
    SortOrder:=msoSortOrderAscending) > 0 Then
        MsgBox "There were " & .FoundFiles.Count & _
            " file(s) found."
            Range("a:a" ).Select
            Selection.ClearContents
        For i = 1 To .FoundFiles.Count
        fname = Mid(.FoundFiles(i), Loogu + 1, Len(.FoundFiles(i)) - Len(Loogu))
            Cells(i, 1) = fname
        Next i
    Else
        MsgBox "There were no files found."
    End If
End With
upperbo = Sheets("feuil1" ).Cells(65527, 1).End(xlUp).Row
lowerbound = 1
For i = 1 To upperbo
upperbound = Sheets("feuil1" ).Cells(65527, 1).End(xlUp).Row
lili = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
Cells(i, 2) = Cells(lili, 1)
 Cells(lili, 1).Select
    Selection.Delete shift:=xlUp
Next i
Range("a:a" ).Select
Selection.Delete shift:=xlLeft
'dossierdep = dossier & "\"
With fs
    .LookIn = dossierarr
    .Filename = fichs
    .Execute
If .FoundFiles.Count > 0 Then Kill dossierarr & "*.jpg"
End With
For i = 1 To upperbo
fichacop = dossier & Cells(i, 1)
fichar = dossierarr & Format(i, "0000" ) & "_" & Cells(i, 1)
FileCopy fichacop, fichar
Next i
End sub
 
Cordialement

C'est ce que je me suis dit aussi mais bon, ça peut pas faire de mal donc allons-y

Soyons fous : la version Java. J'ai craqué, j'ai qu'un vieille version d'Excel à la maison, ça marchait pas comme au boulot. Dégueu, mais ça marche.