XL 2010 Renommer des fichiers à partir d’excel

[jeanmi]

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

 

[Staple1600]

Bonsoir jeanmi, le fil

Regarde en bas de la page dans le section Discussions similaires
Tu devrais trouver des exemples à adapter à ta problématique

 

[jeanmi]

Bonjour "Staple1600, à tous,
merci pour ta réponse, je regarde
Cordialement

 

[TooFatBoy]

Bonjour,

Name, instruction (VBA)

Rubrique de référence sur Office VBA

docs.microsoft.com

 

[soan]

Bonjour,

voici un lien.

soan

 

[jeanmi]

Bonjour,

voici un lien.

Merci pour les liens mais chez moi ça ne fonctionne pas, résultats :

Oups ! Quelque chose ne va pas.​

 

[jeanmi]

Bonjour,

Name, instruction (VBA)

Rubrique de référence sur Office VBA

docs.microsoft.com

Bonjour et merci pour l'aide.
J'ai regardé mais honnêtement, rien compris.
cordialement

 

[TooFatBoy]

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 :

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

 

[sylvanu]

Bonjour Jeanmi, Staple, Marcel, Soan,
Un essai en PJ avec :

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

 

[soan]

Bonjour jeanmi, le fil,

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

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 :​

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

 

[jeanmi]

Bonjour Jeanmi, Staple, Marcel, Soan,
Un essai en PJ avec :

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