XL 2016 Modifier le nom de plusieurs PDF

[Danybrett]

Bonjour,

Ne trouvant pas de réponse sur le net, je me permets de venir ici.
Mon problème est que j'ai une Base de données composée d'environ 20/30 dossiers constitués chacun d'environ 5000 PDF.

Les PDF sont nommés avec des "-" ou des "." ou "_" ou des espaces entre les caractères (exemple: xx-xx_xxx.xx ; xx xxxxx-xx ; xx.xxxx ; xxx_xxx ...).

J’aimerais trouver une macro excel qui renomme tous les PDF d'un dossier en supprimant les points "." , les tirés " - ; _" et les espaces " ". La difficulté est que ces points, tirés, espaces ne sont pas toujours placés aux même endroit.

Si quelqu'un a une solution, je suis preneur. Merci d'avance 🙂

 

[Lone-wolf]

Bonjour Danybrett

Cette macro est juste pour 1 dossier. Ce que tu peux faire, c'est de lister tous les chemins des différents dossiers en feuille 2 par exemple. En feuille 1, tu crée une liste déroulante, ensuite (à tester)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, NbCar&, car$, Chemin$, Rep_Pdf$, NewName$

    Chemin = [B2]  'cellule de la liste

    If [B2] <> "" Then
        Rep_Pdf = Dir(Chemin & "*.*")

        Do While Rep_Pdf <> ""
            NbCar = Len(Rep_Pdf)
            NewName = ""

            For i = 1 To NbCar
                car = Mid(Rep_Pdf, i, 1)
                If InStr("0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ", car) <> 0 Then
                    NewName = NewName & car
                End If
                    Rep_Pdf = NewName
            Next i
        Loop
    Else
        Exit Sub
    End If
End Sub

 

[Usine à gaz]

Bonjour Danybrett, Lone, le Forum,

J'ai souvent eu à modifier des noms de fichiers.

Après bcp de recherches, j'ai trouvé ce petit logiciel gratuit "Ant Renamer" qui fonctionne super bien ..... pour moi.

Vous pouvez le télécharger sur ce lien :
http://www.01net.com/telecharger/windows/Utilitaire/manipulation_de_fichier/fiches/17812.html

Bonne journée à toutes et à tous,
Amicalement,
Arthour973

 

[Danybrett]

Bonjour Lone-wolf

Merci beaucoup pour la réponse. 🙂

Par contre, je dois être nul en macro, mais je n'arrive pas à lancer la macro. En gros, j'ai copié la macro dans un module, j'ai mis le chemin de mon dossier dans la Case "B2" comme indiqué dans la macro. Mais quand je la lance ça ne marche pas. Il me dit, si je comprends bien, qu'il n'y a pas de macro.

Il m'affiche ce message:

 

[Danybrett]

Bonjour arthour,

Je viens de tester ton logiciel. C'est ce que je cherchais.
Par contre il renomme tout, qu'importe l'extension. Il y a une option pour lui dire de ne cibler que les PDF dans un dossier ? 🙂

 

[Lone-wolf]

Re Danybrett

Il ne faut pas mettre le code dans le module de la feuille, mais dans un module standard.

EDIT: bonjour Lionel 🙂

 

[Usine à gaz]

Bonjour arthour,

Je viens de tester ton logiciel. C'est ce que je cherchais.
Par contre il renomme tout, qu'importe l'extension. Il y a une option pour lui dire de ne cibler que les PDF dans un dossier ? 🙂

Re-Bonjour,

Ce petit logiciel est très précis dans son utilisation et il faut bien lire toutes les possibilités et ne tester que sur les fichiers d'un dossier test (donc une copie).
Par exemple, il peut renommer en tout ou partie le nom d'un fichier, c'est une question de choix d'option.
Amicalement,
arthour973,

 

[Usine à gaz]

Bonjour arthour,

Je viens de tester ton logiciel. C'est ce que je cherchais.
Par contre il renomme tout, qu'importe l'extension. Il y a une option pour lui dire de ne cibler que les PDF dans un dossier ? 🙂

Pour ne cibler que les PDF, il ne faut sélectionner que les PDF

 

[Danybrett]

Merci à vous deux pour vos réponses. 😀

 

[job75]

Bonjour DanyBrett, Lone-wolf, Lionel,

@ Lone-wolf : ton code ne renomme pas du tout les fichiers !!!

Cette macro est très simple :

Sub RenommerPDF()
Dim c As Range, chemin$, fichier$, x$
For Each c In Intersect([B:B], ActiveSheet.UsedRange.EntireRow) 'colonne B à adapter éventuellement
    chemin = c & IIf(Right(c, 1) = "\", "", "\")
    fichier = Dir(chemin & "*.pdf") '1er fichier PDF du dossier
    While fichier <> ""
        x = Replace(Replace(Replace(fichier, ".pdf", "|"), ".", ""), "|", ".pdf") 'suppression des points
        x = Replace(Replace(Replace(x, "-", ""), "_", ""), " ", "") 'suppression des tirets et espaces
        Name chemin & fichier As chemin & x 'renomme le fichier
        fichier = Dir 'fichier suivant du dossier
    Wend
Next
End Sub

J'ai supposé que les chemins d'accès des dossiers sont en colonne B, sinon adapter.

A+

 

[job75]

Re,

Il n'est pas impossible qu'après suppression des points, tirets et espaces 2 noms de fichiers du même dossier deviennent identiques.

Alors cela provoquera un bug, vous en ferez ce que vous voulez, par exemple l'éviter avec On Error Resume Next...

A+

 

[Lone-wolf]

Bonjour job75 🙂

Moi j'ai fait comme ceci

Sub Rename_Pdf()
Dim Chemin$, Rep_Pdf$, temp$, NewName$

    Chemin = ThisWorkbook.Path & "\Pdf\"

        Rep_Pdf = Dir(Chemin & "*.*")
         On Error Resume Next
        While Rep_Pdf <> ""
            temp = Replace(Rep_Pdf, "_", "")
            NewName = Replace(temp, "-", "")
            Name Chemin & Rep_Pdf As Chemin & NewName
        Wend
        On Error GoTo 0
End Sub

ça renomme le 1er fichier, puis ça plante.

EDIT: il manquait Rep_Pdf = Dir. Cette fois c'est ok.