Macro renomage fichiers aléatoire

Bonjour biboudet6,

As-tu fait un réel effort de rédaction, ou bien concordes-tu les temps aussi naturellement ? Cette remarque juste parce qu'il est si rare de voir quelqu'un s'exprimer correctement sur les forums, ce dont je te remercie.

En ces temps de rentrée, voilà un premier bon point.

Passons maintenant aux point négatifs...

Premièrement, nous ne réalisons aucun travail, même rémunéré, conformément au règlement. Il va donc falloir que tu t'y colles toi-même, quitte à accepter un peu de notre aide, pas plus !

Deuxièmement, tu ne précises pas quels langages tu souhaites utiliser. Le VB dans le rubrique VB, c'est un minimum. Oui, mais lequel ? VB, VBA (Excel, Word, autre) VBS ?

As-tu une ((toute) petite) idée de l'algorithme à utiliser ?

Tout d'abord merci pour ta réponse rapide.

Ensuite c'est une macro VBA sur excel que j'aimerai avoir.

Troisièmement voici le point de départ que j'ai (à la fin du message): en fait c'est une macros que j'avais fait avec quelqu'un qui s'y connaissait durant un ancien stage. J'aurai aimé adapter cette macro à mes nouveaux types de données mais je n'y suis pas arrivée. Le problème étant que je n'ai pas les mêmes types de dossier, sous dossiers etc...

en gros j'ai un gros dossier "09 09 2009"
dans lequel se trouve plusieurs sous dossier "control" + "1h" + "2h" + etc...
dans chacun de ses dossiers j'ai une liste de fichiers qui se nomment "control_0_vert", "control_0_rouge", "control_0_bleu", "control_1_vert, control_1_rouge", "control_1_bleu"...
et j'aimerai avoir au final un gros dossier qui comprennent toutes les photos mélangées (control, 1h ...) renommées a_0_bleu, a_0_rouge, a_0_vert... pour que je ne sache plus si c'est control, 1h, 2h mais que les trois photos (bleu, vert, rouge)correspondant à la même chose (n°0,1,2...) restent codées de facon cohérente (a_0-rouge, a_0_vert, a_0_bleu). Et que ca me cré un fichier texte qui me donne les correspondances pour que je puisse retrouver après analyse à quoi ca correspond (dans la macros que j'ai mis à la suite la dernière partie est censée faire ca)

Je ne sais pas si c'est très clair...navrée, je sais que c'est un peu compliqué et que je demande beaucoup mais c'est dur pour une biologiste de faire de la programmation sans y avoir jamais touché!

En tout cas un énorme merci ne serait-ce que pour l'intérêt que tu portes à ma requête.


Dim avant(1 To 1000) As String
Dim apres(1 To 1000) As String
Dim suf As String
Dim typ As String

Sub MelangeImages()

Dim chemin As String
Dim nb As Integer

Randomize

'Les images à mélanger doivent être dans un dossier à part; elles vont par deux : "name x" et "name x tub"; le dossier "dossier_shuff" sera détruit
suf = " tub"
chemin = Application.GetOpenFilename(, , "Sélectionner un des fichiers à mélanger")
If chemin = "Faux" Then End

a = ""
b = 1
typ = Mid(chemin, Len(chemin) - 3)
Do Until a = "/" Or a = "\"
a = Mid(chemin, Len(chemin) - b, 1)
b = b + 1
Loop
chemin = Mid(chemin, 1, Len(chemin) - b)
a = ""
b = 1
Do Until a = "/" Or a = "\"
a = Mid(chemin, Len(chemin) - b, 1)
b = b + 1
Loop
dossier = Mid(chemin, Len(chemin) - b + 2)
chemin = Mid(chemin, 1, Len(chemin) - b + 1)

Set fs = Application.FileSearch
With fs
.LookIn = chemin & dossier & "\"
.Filename = "*"
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
reponse = MsgBox(.FoundFiles.Count & _
" fichier(s) " & typ & " trouvé(s)", vbOKCancel)
If reponse = vbCancel Then End

nb = .FoundFiles.Count

For i = 1 To nb
avant(i) = .FoundFiles(i)
avant(i) = Mid(avant(i), Len(chemin & dossier) + 2)
avant(i) = Mid(avant(i), 1, Len(avant(i)) - 4)
Next i

Else
MsgBox "Aucun fichier trouvé"
End
End If

End With

If Int(nb / 2) <> nb / 2 Then
MsgBox "Le nombre de fichiers n'est pas pair..." & Chr(13) & "...interruption du programme.", vbOK, "*** ATTENTION ***"
End
End If

If Mid(avant(1), Len(avant(1)) - 3) = suf Then
For f = 1 To nb Step 2
interm = avant(f)
avant(f) = avant(f + 1)
avant(f + 1) = interm
Next f
End If

ChDir ".."
compt = 1
nouv_dossier = dossier & "_shuf" & compt
Set fs = CreateObject("Scripting.FileSystemObject")
Do Until Not fs.folderexists(nouv_dossier)
compt = compt + 1
nouv_dossier = Mid(nouv_dossier, 1, Len(nouv_dossier) - 1) & compt
Loop
MkDir nouv_dossier
fs.CopyFile chemin & dossier & "\*", chemin & nouv_dossier & "\"
ChDir nouv_dossier

Call tableau_correspondance(nb)

ChDir ".."

MsgBox nouv_dossier, , "MELANGE EFFECTUE"

End Sub

Private Sub tableau_correspondance(n As Integer)

n = n / 2

ReDim choix(1 To n) As Integer
ReDim interm(1 To n) As Integer

For f = 1 To n
interm(f) = f
Next f
ni = n

compt = 0
While ni > 0
compt = compt + 1
has = Int(Rnd * ni) + 1
choix(compt) = interm(has)
If has < ni Then
For f = has To ni - 1
interm(f) = interm(f + 1)
Next f
End If
ni = ni - 1
Wend

For f = 1 To n
titre = "Fichier shuf " & f
apres(1 + (f - 1) * 2) = titre
apres(2 * f) = titre & suf
Next f

Open "Correspondance.txt" For Output As #1

For f = 1 To n
Print #1, apres(1 + (f - 1) * 2) & " = " & avant(1 + (choix(f) - 1) * 2)
Print #1, apres(f * 2) & " = " & avant(choix(f) * 2)
Print #1, ""
Name avant(1 + (choix(f) - 1) * 2) & typ As apres(1 + (f - 1) * 2) & typ
Name avant(choix(f) * 2) & typ As apres(f * 2) & typ
Next f

Close #1

End Sub

Et un troisième mauvais point !
Désolé, mais je suis un modérateur tatillon !
Et toi, un nouveau membre qui n'a pas lu le règlement.



Modifie (ne recommence pas tout, édite) ton message précédent et mon présent message s'autodétruira.

Tout d'abord merci pour ta réponse rapide.

Ensuite c'est une macro VBA sur excel que j'aimerai avoir.

Troisièmement voici le point de départ que j'ai (à la fin du message): en fait c'est une macros que j'avais fait avec quelqu'un qui s'y connaissait durant un ancien stage. J'aurai aimé adapter cette macro à mes nouveaux types de données mais je n'y suis pas arrivée. Le problème étant que je n'ai pas les mêmes types de dossier, sous dossiers etc...

en gros j'ai un gros dossier "09 09 2009"
dans lequel se trouve plusieurs sous dossier "control" + "1h" + "2h" + etc...
dans chacun de ses dossiers j'ai une liste de fichiers qui se nomment "control_0_vert", "control_0_rouge", "control_0_bleu", "control_1_vert, control_1_rouge", "control_1_bleu"...
et j'aimerai avoir au final un gros dossier qui comprennent toutes les photos mélangées (control, 1h ...) renommées a_0_bleu, a_0_rouge, a_0_vert... pour que je ne sache plus si c'est control, 1h, 2h mais que les trois photos (bleu, vert, rouge)correspondant à la même chose (n°0,1,2...) restent codées de facon cohérente (a_0-rouge, a_0_vert, a_0_bleu). Et que ca me cré un fichier texte qui me donne les correspondances pour que je puisse retrouver après analyse à quoi ca correspond (dans la macros que j'ai mis à la suite la dernière partie est censée faire ca)

Je ne sais pas si c'est très clair...navrée, je sais que c'est un peu compliqué et que je demande beaucoup mais c'est dur pour une biologiste de faire de la programmation sans y avoir jamais touché!

En tout cas un énorme merci ne serait-ce que pour l'intérêt que tu portes à ma requête.

Dim avant(1 To 1000) As String 

Dim apres(1 To 1000) As String 

Dim suf As String 

Dim typ As String 

 
Sub MelangeImages() 

 
Dim chemin As String 

Dim nb As Integer 

 
Randomize 

 
'Les images à mélanger doivent être dans un dossier à part; elles vont par deux : "name x" et "name x tub"; le dossier "dossier_shuff" sera détruit 

suf = " tub" 

chemin = Application.GetOpenFilename(, , "Sélectionner un des fichiers à mélanger" ) 

If chemin = "Faux" Then End 

 
a = "" 

b = 1 

typ = Mid(chemin, Len(chemin) - 3) 

Do Until a = "/" Or a = "\" 

a = Mid(chemin, Len(chemin) - b, 1) 

b = b + 1 

Loop 

chemin = Mid(chemin, 1, Len(chemin) - b) 

a = "" 

b = 1 

Do Until a = "/" Or a = "\" 

a = Mid(chemin, Len(chemin) - b, 1) 

b = b + 1 

Loop 

dossier = Mid(chemin, Len(chemin) - b + 2) 

chemin = Mid(chemin, 1, Len(chemin) - b + 1) 

 
Set fs = Application.FileSearch 

With fs 

.LookIn = chemin & dossier & "\" 

.Filename = "*" 

If .Execute(SortBy:=msoSortByFileName, _ 

SortOrder:=msoSortOrderAscending) > 0 Then 

reponse = MsgBox(.FoundFiles.Count & _ 

" fichier(s) " & typ & " trouvé(s)", vbOKCancel) 

If reponse = vbCancel Then End 

 
nb = .FoundFiles.Count 

 
For i = 1 To nb 

avant(i) = .FoundFiles(i) 

avant(i) = Mid(avant(i), Len(chemin & dossier) + 2) 

avant(i) = Mid(avant(i), 1, Len(avant(i)) - 4) 

Next i 

 
Else 

MsgBox "Aucun fichier trouvé" 

End 

End If 

 
End With 

 
If Int(nb / 2) <> nb / 2 Then 

MsgBox "Le nombre de fichiers n'est pas pair..." & Chr(13) & "...interruption du programme.", vbOK, "*** ATTENTION ***" 

End 

End If 

 
If Mid(avant(1), Len(avant(1)) - 3) = suf Then 

For f = 1 To nb Step 2 

interm = avant(f) 

avant(f) = avant(f + 1) 

avant(f + 1) = interm 

Next f 

End If 

 
ChDir ".." 

compt = 1 

nouv_dossier = dossier & "_shuf" & compt 

Set fs = CreateObject("Scripting.FileSystemObject" ) 

Do Until Not fs.folderexists(nouv_dossier) 

compt = compt + 1 

nouv_dossier = Mid(nouv_dossier, 1, Len(nouv_dossier) - 1) & compt 

Loop 

MkDir nouv_dossier 

fs.CopyFile chemin & dossier & "\*", chemin & nouv_dossier & "\" 

ChDir nouv_dossier 

 
Call tableau_correspondance(nb) 

 
ChDir ".." 

 
MsgBox nouv_dossier, , "MELANGE EFFECTUE" 

 
End Sub 

 
Private Sub tableau_correspondance(n As Integer) 

 
n = n / 2 

 
ReDim choix(1 To n) As Integer 

ReDim interm(1 To n) As Integer 

 
For f = 1 To n 

interm(f) = f 

Next f 

ni = n 

 
compt = 0 

While ni > 0 

compt = compt + 1 

has = Int(Rnd * ni) + 1 

choix(compt) = interm(has) 

If has < ni Then 

For f = has To ni - 1 

interm(f) = interm(f + 1) 

Next f 

End If 

ni = ni - 1 

Wend 

 
For f = 1 To n 

titre = "Fichier shuf " & f 

apres(1 + (f - 1) * 2) = titre 

apres(2 * f) = titre & suf 

Next f 

 
Open "Correspondance.txt" For Output As #1 

 
For f = 1 To n 

Print #1, apres(1 + (f - 1) * 2) & " = " & avant(1 + (choix(f) - 1) * 2) 

Print #1, apres(f * 2) & " = " & avant(choix(f) * 2) 

Print #1, "" 

Name avant(1 + (choix(f) - 1) * 2) & typ As apres(1 + (f - 1) * 2) & typ 

Name avant(choix(f) * 2) & typ As apres(f * 2) & typ 

Next f 

 
Close #1 

 
End Sub

Bon, ben puisque tu n'as pas modifié ton message, mais que tu as tout réécrit, je suis obligé de laisser mon message, pour rester cohérent. Du coup, ça c'est tout moche, mais c'est ton topic, après tout !  



 

Fiiiiiiiouuuuuuu !
C'est coton tout truc.
Pis y'a pas d'indentation, c'est donc difficilement lisible.
Pis y'a pleins d'interactions pas demandées.

Moi je me proposais de te proposer (   ) ça :

Ouvrir le fichier "correspondance"  en ajout.

Pour tous les dossiers du dossier courant faire :

	Retenir le nom du dossier

	Faire :

		Inventer un nom aléatoire

	Tant qu'aucun dossier ne porte déjà ce nom

	Ecrire le nom du dossier et le nom aléatoire dans le fichier

	Renommer le dossier

Suivant

Fermer le fichier

Qu'en dis-tu ?

Après, chaque fichier dossier/fichier_couleur est copié vers fichier_couleur_dossier et le tour est joué.

Qu'en penses-tu ?