Discussion :

[D-D-Du-06]

Bonjour à toutes et à tous,

étant totalement néophyte (ou à peine autodidacte en VBA), j'ai quelques difficultés.

Je souhaite réaliser (et améliorer) une petite macro pour renommer une série de fichiers à partir d'une liste excel.

--------- Voilà le problème ------------------------

Dans la colonne B, les nouveaux noms.
Dans la colonne F, les anciens noms.
(Au départ B et F sont remplis automatiquement par une macro qui recherche et affiche le contenu d'un dossier ciblé).

La petite macro ci-dessous fonctionne uniquement si la totalité des noms de la colonne B est différente de la colonne F.

Si un nom dans la colonne B est identique à celui de la colonne F, ça ne marche plus.

Je voudrais pouvoir changer le nom de certains fichiers (en colonne B).
Il faudrait donc intégrer une espèce de test (genre If etc...) sur chaque ligne : pour comparer B à F et si B est différent de F on renomme sinon on passe à la ligne suivante...

Et ça je n'y arrive pas !!

La macro (déjà bien pratique)

Code :

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

1
2
3
4
5
6
7
8
Sub Renom()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set repertoire = FSO.GetFolder(ActiveSheet.Cells(1, 1))
Set fichiers = repertoire.Files
For Each f In fichiers
    f.Name = Cells(Application.WorksheetFunction.Match(f.Name, Range("f:f"), 0), 2).Value
Next
End Sub

-------------------------------------------------------------------------

Merci d'avance...
A+
D D du 06

[Docmarti]

Il suffit de gérer les différentes erreurs qui surviennent.

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
Sub Renom()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set repertoire = FSO.GetFolder(ActiveSheet.Cells(1, 1))
Set fichiers = repertoire.Files
For Each f In fichiers
On Error GoTo GererLesErreurs
    NouveauNom = Cells(Application.WorksheetFunction.Match(f.Name, Range("f:f"), 0), 2).Value
    f.Name = Cells(Application.WorksheetFunction.Match(f.Name, Range("f:f"), 0), 2).Value
Suite:
Next
Exit Sub
GererLesErreurs:
Message = "Ancien nom : " & f.Name & vbCrLf & "Nouveau nom : " & NouveauNom
MsgBox Error & vbCrLf & Message
Resume Suite
End Sub

[pgz]

Bonsoir.

Dans la colonne B, les nouveaux noms.
Dans la colonne F, les anciens noms.
....

Si un nom dans la colonne B est identique à celui de la colonne F, ça ne marche plus.

Et il se passe quoi exactement dans ce cas là?

PGZ

[D-D-Du-06]

Bonjour à toutes et à tous,

pour répondre à Pgz, voilà ce qui se passe:
_ Message d'alerte de Visual Basic : Erreur d'exécuton '58';
_ avec la ligne

Code :

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

1
2
f.Name = Cells(Application.WorksheetFunction.Match(f.Name, Range("f:f"), 0), 2).Value
Suite:

surlignée dans VBA;
_ et aucun fichier renommé...

Grand Merci du coup de main à Domacri .

Ci-dessous, son code légèrement modifié et tout fonctionne (quand même nom, juste une jolie boîte de dialogue).

----------------------------------------------
Le code qui fonctionne

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
Sub Renom()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set repertoire = FSO.GetFolder(ActiveSheet.Cells(1, 1))
Set fichiers = repertoire.Files
For Each f In fichiers
On Error GoTo GererLesErreurs
    f.Name = Cells(Application.WorksheetFunction.Match(f.Name, Range("f:f"), 0), 2).Value
Suite:
Next
Exit Sub
GererLesErreurs:
Message = "Ancien nom : " & f.Name & vbCrLf & "Nouveau nom : " & f.Name & vbCrLf
MsgBox Error & vbCrLf & Message
Resume Suite
End Sub

-----------------------------------------------------

Merci encore à tous les deux pour la solution et l'intérêt porté au message.

A+
D D du 06

[Docmarti]

Si tu ne veux pas connaître les erreurs générées, tu peux utiliser simplement ceci:

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Renom()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set repertoire = FSO.GetFolder(ActiveSheet.Cells(1, 1))
Set fichiers = repertoire.Files
For Each f In fichiers
On Error Resume Next
    f.Name = Cells(Application.WorksheetFunction.Match(f.Name, Range("f:f"), 0), 2).Value
Next
 
End Sub