Renommer des fichiers en VBA [Résolu/Fermé]

Messages postés
511
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
2 décembre 2019
- - Dernière réponse : Mistral_13200
Messages postés
511
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
2 décembre 2019
- 24 déc. 2015 à 08:41
Bonjour à tous,

A partir d’un fichier Excel, dans lequel j’ai :
- Colonne A le nom du répertoire d’origine qui n’est pas toujours le même.
- Colonne B le nom du fichier à déplacer.
- Colonne C le nom du répertoire de destination qui lui est identique pour tous les fichiers copiés.
Je copie le fichier xxxx.jpeg (colonne B) du répertoire d’origine vers le répertoire de destination. Pour cela j’utilise la macro suivante :

Sub Copie_Fichier ()
' Copie les fichiers des photos pour le diaporama dans le répertoire destination.

Dim fso As Object, Rep_Départ, Rep_Arrivée, Fichier_Copié

Set fso = CreateObject("Scripting.FileSystemObject")
Rep_Arrivée = Range("C2")
Range("A2").Activate
Do Until ActiveCell = ""
Rep_Départ = ActiveCell
Fichier_Copié = ActiveCell.Offset(0, 1)
fso.CopyFile Rep_Départ & "\" & Fichier_Copié, Rep_Arrivée & "\" & Fichier_Copié
ActiveCell.Offset(1, 0).Activate
Loop
End Sub

Cela fonctionne parfaitement.
Maintenant je souhaiterais par la même occasion renommer le fichier déplacé de manière à obtenir un nom de fichier de ce type :
- Une partie fixe commune à tous les fichiers.
- Une partie variable dépendante du nombre de ligne contenu du fichier contenant les fichiers à déplacer.
- Une nouvelle partie fixe identique pour tous les fichiers.

Pour obtenir un nom de fichier ressemblante à ça : XXXXXX1Y.Jpeg
Je coince sur la boucle à mettre en place dans ma macro. Comment Faire ?

Merci d’avance à tous ceux qui se pencheront sur mon problème.

Cordialement.
Mistral
Afficher la suite 

6 réponses

Meilleure réponse
Messages postés
6409
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
2 décembre 2019
418
1
Merci
comme ceci:


FileCopy chemindepart & "\" & nom, cheminarrive & "\" & nouveaunom & NoLig & "y.jpg"

Dire « Merci » 1

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65072 internautes nous ont dit merci ce mois-ci

Messages postés
511
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
2 décembre 2019
3
0
Merci
Tout d'abord merci à toi te t'intéresser à mon problème.
Je vais tester ça.

Oui je souhaite une incrémentation automatique de 1, pour la première photo à "xx" pour la dernière photo.
Messages postés
6409
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
2 décembre 2019
418
0
Merci
Bonjour,

comme ceci:

Sub For_X_to_Next_Ligne()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
Dim chemindepart, cheminarrive, nom, nouveaunom As String
Dim DernLigne As Long
nouveaunom = "monimage" 'a adapter
DernLigne = Range("A65536").End(xlUp).Row
    Set FL1 = Worksheets("Feuil1")
    NoCol = 1 'lecture de la colonne 1
    For NoLig = 1 To DernLigne
        chemindepart = FL1.Cells(NoLig, NoCol)
        nom = FL1.Cells(NoLig, NoCol + 1)
        cheminarrive = FL1.Cells(NoLig, NoCol + 2)
        Name chemindepart & "\" & nom As cheminarrive & "\" & nouveaunom & NoLig & "y.jpg"
    Next
    Set FL1 = Nothing
End Sub

Messages postés
511
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
2 décembre 2019
3
0
Merci
Bonjour Pivert,

Merci à toi pour ta macro.
Elle fonctionne correctement mais ce n'est pas exactement ce que je souhaite.
Toi tu déplaces la photo d'un répertoire à un autre alors que je souhaitais copier la photo en laissant l'original à sa place.

Une chose que je n'avais pas mentionnée c'est qu'il y a une ligne de titre mais pour corriger cela j'ai démarrer la boucle For to à 2 au lieu de 1 et fait NoLig-1 pour définir le nouveau nom. Cela semble fonctionner correctement

D'autre part le répertoire de destination est le même pour toutes les photos copiées chose que je peux corriger en faisant : cheminarrivee= Range("C1").

Si tu pouvais me dire comment copier au lieu de déplacer às finaliserait la macro.
D'avance merci.
Mistral
cs_Le Pivert
Messages postés
6409
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
2 décembre 2019
418 -
Messages postés
511
Date d'inscription
mardi 5 août 2008
Statut
Membre
Dernière intervention
2 décembre 2019
3
0
Merci
Bonjour,

Merci à tous pour votre aide.
Je suis arrivé à ce que je cherché en adaptant vos solutions à mes besoins.
Je clos ce post mais j'en ouvre un autre concernant le déplacement de ligne en VBA.

Bonnes fêtes à tous.
Cordialement
Mistral
Messages postés
1145
Date d'inscription
lundi 10 mai 2010
Statut
Membre
Dernière intervention
26 mars 2019
69
-1
Merci
Bonjour,

Tu peux utiliser ca :
sub test()
Name "D:\aaa.jpeg" As "D:\AutreRep\bbbbb.jepg"
end sub


Pour la boucle, tu veux une incrémentation automatique ?