XL 2010 Renommer des fichiers à partir d’excel

jeanmi

XLDnaute Occasionnel
Bonjour à tous,

Je cherche comment faire pour renommer des fichiers à partir d'Excel 2010.

Je m’explique :

J’ai un répertoire ou il y a des fichiers qui sont nommés comme cela = DOSSSIER NOM PRENOM AUTRES INFO.pdf

Je souhaiterais modifier le nommage de tous les fichiers en = NOM PRENOM AUTRES INFO DOSSIER.pdf , donc que DOSSIER se trouve à la fin

De plus, si possible, il y a des fois ou les noms ou autre sont en minuscules, si possible passer tous en majuscule.

Merci de votre aide.

Cordialement
 

TooFatBoy

XLDnaute Barbatruc
J'ai regardé mais honnêtement, rien compris.
C'est un lien vers l'instruction VBA qui permet de renommer un fichier.

En reprenant l'exmple du lien, on obtiendrait quelque chose comme ça :
VB:
Sub Renommer()
'
Dim NomAncien$, NomNouveau$
Dim ZeDossier$, ZeNom$, ZePrenom$, ZeAutres$, ZeInfo$

    NomAncien = "DOSSSIER NOM PRENOM AUTRES INFO.pdf"

    ZeDossier = Split(NomAncien, " ")(0)
    ZeNom = Split(NomAncien, " ")(1)
    ZePrenom = Split(NomAncien, " ")(2)
    ZeAutres = Split(NomAncien, " ")(3)
    ZeInfo = Split(Split(NomAncien, " ")(4), ".")(0)

    NomNouveau = ZeNom & " " & ZePrenom & " " & ZeAutres & " " & ZeInfo & " " & ZeDossier & ".pdf"

    Name NomAncien As NomNouveau

End Sub
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Jeanmi, Staple, Marcel, Soan,
Un essai en PJ avec :
VB:
Sub Renommage()
    On Error GoTo Fin:
    Dim Dossier$, Fichier$, Separateur$, Corps$, NouveauNom$, Ligne%, i%
    Separateur = Application.PathSeparator                              ' Séparateur "\" pour Win et "/" pour Mac.
    Range("C10:G1000").ClearContents: [Bilan] = ""                      ' Clear écran
    Dossier = [Chemin]                                                  ' Lecture chemin accés
    If Right(Dossier, 1) <> Separateur Then Dossier = Dossier & Separateur ' ' Ajoute le séparateur final si absent
    i = 0: Ligne = 9
    Fichier = Dir(Dossier)
    Do While Fichier <> ""                                              ' On parcourt tous les fichiers
        i = i + 1: Ligne = Ligne + 1
        ' Ne traite que les fichiers commençant par "Dossier" et finissant par ".pdf"
        If Left(UCase(Fichier), 7) = "DOSSIER" And Right(Fichier, 4) = ".pdf" Then
            Corps = Mid(Fichier, 9, Len(Fichier) - 12)                  ' Extrait la partie centrale du nom
            NouveauNom = UCase(Corps & " dossier") & ".pdf"             ' Construction nouveau nom
            On Error Resume Next                                        ' Si le fichier existe déjà on passe
            Name Dossier & Fichier As Dossier & NouveauNom              ' Renomme le fichier
            [Bilan] = i & " fichiers traités."                          ' Met à jour l'écran
            Cells(Ligne, "C") = Fichier: Cells(Ligne, "G") = NouveauNom
        End If
        Fichier = Dir
    Loop
Fin:
End Sub
 

Pièces jointes

  • RenommageFichier.xlsm
    18.8 KB · Affichages: 5

soan

XLDnaute Barbatruc
Inactif
Bonjour jeanmi, le fil,

Image 1.jpg


quand tu cliques sur mon lien, ça mène sur cet écran :

Image 2.jpg


clique sur un des 2 liens bleus : "Renommer des fichiers en masse avec Excel" ou "En savoir plus sur cette ressource..." ; pour les 2 liens, ça mène à cet écran :​

Image 3.jpg


en haut à droite, clique sur le bouton "Télécharger" (en blanc sur fond orange).

ça télécharge le fichier "Excel Renome.xlsm". :)



en suivant la procédure ci-dessus, à aucun moment j'ai eu le message d'erreur
"Oups ! Quelque chose ne va pas." ; je ne sais pas à la suite de quoi tu l'as vu.


essaye en suivant les étapes que j'ai décrites ; ça devrait marcher ! sinon,
indique en faisant quoi tu as le message d'erreur.



pour aller directement sur le 2ème écran (avec le bouton "Télécharger"),
clique sur ce lien. (le bouton est au même endroit, en haut à droite)



à tout hasard, je mets ici le fichier Excel de Hervé S. (salut)

soan
 

Pièces jointes

  • Excel Renome.xlsm
    177.5 KB · Affichages: 4

jeanmi

XLDnaute Occasionnel
Bonjour Jeanmi, Staple, Marcel, Soan,
Un essai en PJ avec :
VB:
Sub Renommage()
    On Error GoTo Fin:
    Dim Dossier$, Fichier$, Separateur$, Corps$, NouveauNom$, Ligne%, i%
    Separateur = Application.PathSeparator                              ' Séparateur "\" pour Win et "/" pour Mac.
    Range("C10:G1000").ClearContents: [Bilan] = ""                      ' Clear écran
    Dossier = [Chemin]                                                  ' Lecture chemin accés
    If Right(Dossier, 1) <> Separateur Then Dossier = Dossier & Separateur ' ' Ajoute le séparateur final si absent
    i = 0: Ligne = 9
    Fichier = Dir(Dossier)
    Do While Fichier <> ""                                              ' On parcourt tous les fichiers
        i = i + 1: Ligne = Ligne + 1
        ' Ne traite que les fichiers commençant par "Dossier" et finissant par ".pdf"
        If Left(UCase(Fichier), 7) = "DOSSIER" And Right(Fichier, 4) = ".pdf" Then
            Corps = Mid(Fichier, 9, Len(Fichier) - 12)                  ' Extrait la partie centrale du nom
            NouveauNom = UCase(Corps & " dossier") & ".pdf"             ' Construction nouveau nom
            On Error Resume Next                                        ' Si le fichier existe déjà on passe
            Name Dossier & Fichier As Dossier & NouveauNom              ' Renomme le fichier
            [Bilan] = i & " fichiers traités."                          ' Met à jour l'écran
            Cells(Ligne, "C") = Fichier: Cells(Ligne, "G") = NouveauNom
        End If
        Fichier = Dir
    Loop
Fin:
End Sub
Bonjour #sylvanu à tous,
merci beaucoup pour vos participation avec un peut de retard et un grand merci à SYLVANU ça fonctionne à merveille et en plus je vais pouvoir l'utiliser dans plusieurs cas.
Bien cordialement
 

Discussions similaires

Statistiques des forums

Discussions
299 878
Messages
1 979 746
Membres
206 854
dernier inscrit
Anthonioo