Renommer fichier suivant condition d'égalité entre 2 cellules

[Dupond987]

Bonjour à tous,

Je souhaiterais adapter ce code trouvé sur ce forum ici :

http://www.excel-downloads.com/forum/126880-renommer-les-noms-de-fichiers-dun-rep-automatiquement.html

:

Sub ListeFichiers_rech()
'CbernardT http://www.excel-downloads.com/forum...e-fichier.html

'Application.Goto Reference:="zae"
    'Selection.ClearContents
    Range("A1").Select
Dim Dossier As Object, Fichier As Object
Dim Chemin As String
Dim I As Long
'Chemin du dossier à analyser (à adapter au besoin)
'Chemin = ThisWorkbook.Path
Chemin = ActiveSheet.Range("A1").Value 'Sheets("paramètrage").Range("b5").Value
'Chemin = "c:\"
'Définition de la variable
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
' Boucle sur les fichiers
Range("a2").Select
I = 2
'Stop
For Each Fichier In Dossier.Files

'Cells(I, 1) = Fichier.Name ' Nom du fichier
'Cells(I, 2) = Fichier.DateCreated ' Date dernière modification
        Cells(I, 1).Formula = Fichier.Path
        Cells(I, 2).Formula = Fichier.Name
        Cells(I, 3).Formula = Fichier.Size
        Cells(I, 4).Formula = Fichier.Type
        Cells(I, 5).Formula = Fichier.DateCreated
        Cells(I, 6).Formula = Fichier.DateLastAccessed
        Cells(I, 7).Formula = Fichier.DateLastModified
        'Cells(I, 8).Formula = Fichier.ParentFolder
        I = I + 1
Next
End Sub
Sub renomme()
I = 1
For Each cell In Range("A2:A" & Range("A65536").End(xlUp).Rows.Row)
oldname = cell
newname = Cells(1, 1).Value & "\" & "temp" & I & ".txt"
I = I + 1
Name oldname As newname
Next
End Sub

Je souhaiterais renommer mes fichiers non pas ent tempn.txt mais par rapport à une condition qui sera une équivalence de contenus de deux cellules. Explications :
Après avoir executé la 1ère macro du code ci-dessous (allègement du code cité précédemment), le nom des fichiers de mon dossier se trouvent dans la colonne A :

Sub ListeFichiers_rech()
'CbernardT http://www.excel-downloads.com/forum...e-fichier.html

Range("A1").Select
Dim Dossier As Object, Fichier As Object
Dim Chemin As String
Dim I As Long
'Chemin du dossier à analyser (à adapter au besoin)
Chemin = ActiveSheet.Range("A1").Value 'Sheets("paramètrage").Range("b5").Value
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
' Boucle sur les fichiers
Range("A2").Select
I = 2
For Each Fichier In Dossier.Files
        Cells(I, 1).Formula = Fichier.Name
        I = I + 1
Next
End Sub
Sub renomme()

Je souhaiterais renommer mes fichiers suivant la condition suivante :
Si la valeur d'une cellule dans la colonne A est égale à la valeur d'une cellule dans la colonne AC alors renommer le fichier correspondant avec la valeur de la cellule de la même ligne mais dans la colonne N (qui elle ne contient pas d'extentsion de fichier qui est toujours .jpg).

Exemple :

Colonne A----------Colonne N----------Colonne AC
C1080.JPG---------0503DATA0113------C1660.jpg
C1166.jpg---------0505DATA0004------HC480003.jpg
C129702.JPG------ 0503DATA0231------C2637.jpg
C129703.JPG------0503DATA0232-------C1080.jpg
C1345.JPG---------0505DATA0002------C1356.jpg
C1355.JPG---------0503DATA0287------C129702.jpg
C1356.JPG---------0503DATAN0288-----C2634.jpg

Par rapport au informations précédentes les noms de fichiers dans mon répertoire prennent les valeurs suivantes :

Le nom de fichier C1080.JPG devient 0503DATA0232.JPG (Valeur de la cellule de la colonne N sur la même ligne que la valeur de la cellule de la colonne AC). Mais ne devient pas 0503DATA0113.JPG.
Le nom de fichier C129702.JPG devient 0503DATA0287.JPG. Mais ne devient pas 0503DATA0231.JPG.
Le nom de fichier C1356.JPG devient 0505DATA0002.JPG. Mais ne devient pas 0503DATAN0288.JPG.

Voilà, j'espère avoir été assez explicite pour que vous puissiez m'aider.

D'avance, je vous remercie.

Cordialement.

Dupond987

 

[jp14]

Re : Renommer fichier suivant condition d'égalité entre 2 cellules

Bonjour

Comment trouve-t-on 0232 de 0503DATA0232
Le nom de fichier C1080.JPG devient 0503DATA0232.JPG (Valeur de la cellule de la colonne N sur la même ligne que la valeur de la cellule de la colonne AC)
avec ces valeurs
Colonne A----------Colonne N----------Colonne AC
C1080.JPG---------0503DATA0113------C1660.jpg

JP

 

[Dupond987]

Re : Renommer fichier suivant condition d'égalité entre 2 cellules

A priori je n'ai pas expliqué correctement ce que je voudrais.

On trouve 0503DATA0232 pour le fichier à renommer c1080.jpg car on doit faire référence à la cellule AC et non pas à la cellule A pour le renommer. C'est ce que je veux dire quand j'explique :

Le nom de fichier C1080.JPG devient 0503DATA0232.JPG (Valeur de la cellule de la colonne N sur la même ligne que la valeur de la cellule de la colonne AC). Mais ne devient pas 0503DATA0113.JPG.

Donc, par rapport à l'exemple :

Colonne A----------Colonne N----------Colonne AC
C129703.JPG------0503DATA0232-------C1080.jpg

et non pas :

Colonne A----------Colonne N----------Colonne AC
C1080.JPG---------0503DATA0113------C1660.jpg

Les noms de fichier dans la colonne A sont générés par la macro. Je veux les comparer avec ceux contenus dans la colonne AC et renommer les fichiers dans mon répertoire du nom de la cellule dans la colonne N. Mais la cellule de référence pour renommer le fichier est la cellule AC et non la cellule A.

Voilà, j'espère qu'avec ces précisions supplémentaires, ça sera un peu plus clair.

Merci à vous pour votre aide.

Cordialement.

 

[jp14]

Re : Renommer fichier suivant condition d'égalité entre 2 cellules

Bonsoir

Ci joint un fichier avec une procédure à modifier pour l'adapter à ton application.

La procédure recherche si la valeur de la colonne A se trouve dans la colonne C si oui elle recopie dans la colonne D le futur nom qui se trouve dans la colonne B.

A tester

JP

 

[Dupond987]

Re : Renommer fichier suivant condition d'égalité entre 2 cellules

Merci JP14,

Je pense que dans ton message tu voulais dire :

La procédure recherche si la valeur de la colonne A se trouve dans la colonne C et si oui elle recopie dans la colonne D le futur nom grace à la valeur de la colonne B.

au lieu de :

La procédure recherche si la valeur de la colonne A se trouve dans la colonne B si oui elle recopie dans la colonne D le futur nom

Grâce à toi, j'ai un peu avancé. Maintenant, j'ai mon nouveau nom de fichier dans ma colonne D.
Maintenant comment renommer les fichiers dans mon répertoire avec le nouveau nom contenu dans la cellule D. Par rapport au fichier que tu m'as mis en pièce jointe j'ai donc pour exemple :

Colonne A----------Colonne B----------Colonne C---------Colonne D
C129702.JPG------ 0503DATA0231------C2637.jpg---------0503DATA0287.jpg

Je voudrais que dans mon répertoire où sont stockées mes images, l'image dont le nom est c129702.jpg (colonne A) devienne 0503DATA0287.JPG (colonne D).

J'ai essayé d'adapter le code suivant :

Sub renomme()
I = 1
For Each cell In Range("A2:A" & Range("A65536").End(xlUp).Rows.Row)
oldname = cell
newname = Cells(1, 1).Value & "\" & "temp" & I & ".txt"
I = I + 1
Name oldname As newname
Next
End Sub

Mais sans succès.

Merci à tous pour votre aide.

Cordialement.

 

[Dupond987]

Re : Renommer fichier suivant condition d'égalité entre 2 cellules

Bon alors,

J'ai modifié le code de cette façon :

Sub renomme()
I = Cells(2, 4).Value
For Each cell In Range("A2:A" & Range("A65536").End(xlUp).Rows.Row)
oldname = I
newname = Cells(1, 1).Value & "\" & I
I = Cells(Range("D2:D92").Row + 1, 8)
Name oldname As newname
Next
End Sub

Mais Excel me surligne en jaune : Name oldname As newname
et m'informe qu'il ne trouve pas le fichier (fichier introuvable).

De plus, si j'ajoute une MsgBox avant la ligne Name oldname as newname, Excel prend bien en compte le changement de nom pour les 2 premiers fichiers mais pas pour les suivants (j'en ai 92 d'où d92). Est-il possible de modifier le +1 à la ligne

I = Cells(Range("D2:D92").Row + 1, 8)

par une plage de ligne à traiter du style +1 à +91

Merci à vous pour votre aide.

Cordialement.

 

[jp14]

Re : Renommer fichier suivant condition d'égalité entre 2 cellules

Bonjour

Ci dessous le code pour changer le nom des fichiers

Private Sub CommandButton3_Click()
Dim data1 As String
Dim cellule As Range
With Sheets("Base")
' la colonne j contient les nouveaux noms
For Each cellule In .Range("j5:j1000")' à modifier en fonction de la colonne
    If cellule.Value <> "" Then
' l'ancien nom se trouve dans la colonne d'ou l'offset par rapport à j
        OldName = cellule.Offset(0, -7).Value ' à modifier
'a2 contient le chemin sans \ en fin du chemin
        NewName = [A2] & "\" & cellule.Value
        Name OldName As NewName    ' renomme le fichier.
        cellule.Value = "" ' cela permet de savoir que le fichier a été renommé
    End If
    
Next cellule
    
    'Application.ScreenUpdating = True
End With


End Sub

JP