Discussion :

[re]

Bonjour,
Pouvez-vous m’aider pour réaliser ceci :
Dans un feuille Excel j’ai extrait les noms des photos avec l’extension, ex : photo_001.jpg
Dans cette même feuille l’on note les photos
Image
Une fois toutes les photos notées il faudrait renommer les fichiers photos avec un classement de la note la plus élevées à la moins élevée => n° d’ordre à 3 chiffres+ note + nom du fichier original. (voir fichier joint)
Si trop compliqué ou pas fiable, l’on ne mettra que la note devant le fichier, sans compter qu’il y aura des exæquos pour l’instant on ne le gère pas.

Idéalement il faudrait aller choisir par l'explorateur le répertoire des photos originales et copier les nouveaux fichiers renommés dans un autre répertoire à sélectionner lui aussi.
Il est important que le renommage se fasse dans une cellule avec Concaténer (ça me permet d'y ajouter d'autre infos par exemple l'auteur)

J’ai trouvé cette macro mais elle n’est pas complète et je ne suis pas assez spécialiste pour aller plus loin…

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub test2()
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set repertoire = Fso.GetFolder("C:\Users\Utilisateur\Pictures\Test")
  Set fichiers = repertoire.Files
  For  Each f In fichiers
      f.Name = Cells(Application.WorksheetFunction.Match(f.Name, Range("a:a"), 0), 2).Value
  Next
  End  Sub

Merci beaucoup

[EBRAG]

Bonjour,

voici une piste....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub test2()
Dim Fso As Object
Dim Repertoire As Object
Dim Fichiers
Dim f
Dim Dest As String
Dim NomFinal As String
Dest = "C:\Users\acer6\Documents\Documents Joel\T2\"
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set Repertoire = Fso.getfolder("C:\Users\acer6\Documents\Documents Joel\Divers Perso")
  Set Fichiers = Repertoire.Files
  For Each f In Fichiers
    'f.Copy Dest
    NomFinal = Application.WorksheetFunction.Index(Range("B1").EntireColumn, Application.WorksheetFunction.Match(f.Name, Range("A1").EntireColumn, 0), 1)
    FileCopy "C:\Users\acer6\Documents\Documents Joel\Divers Perso\" & f.Name, Dest & NomFinal & ".xlsm"
  Next
  End Sub

[re]

Désolé je ne suis pas un spécialiste du VBA mais je m'y intéresse.
J'ai essayé de comprendre mais je n'arrive pas faire fonctionner cette macro
Joel\T2\ est bien le repertoire de destination et Divers Perso\" le repertoire d'origine ?
Je suppose que l'emplacement du fichier n'a pas d'importance il faut bien mettre la macro dans un module ou la feuille1 ?

Merci

[EBRAG]

Bonjour,

le répertoire de destination est "C:\Users\acer6\Documents\Documents Joel\T2\"

il faut donc modifier la variable en conséquence.

La variable ou se trouve le fichier d'origine est :
"C:\Users\acer6\Documents\Documents Joel\Divers Perso"

là aussi, adapter en conséquence

Mettre la macro de préférence dans un module.

[re]

Merci pour ta réponse
C'est exactement ce que j'ai fait
J'ai crée un rep ''copy2'' le tiens T2
j'ai 3 photos dans le repertoire d'origine pour 'copy' toi 'Divers Perso'
feuille1 => col A 'nom d'origine' => col B nouveau nom
Lorsque je lance la macro il y a erreur à cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 NomFinal = Application.WorksheetFunction.Index(Range("B1").EntireColumn, Application.WorksheetFunction.Match(f.Name, Range("A1").EntireColumn, 0), 1)

[EBRAG]

Re ,

évidemment, il convient d'adapter les plage source....

pour moi, Range("B1").EntireColumn est la plage où se trouvent les nouveaux noms Range("G10:G12") dans le fichier joint

et Range("A1").EntireColumn est la plage ou se trouvent les anciens noms !!!! Range("A10:A12") dans le fichier joint