XL 2010 VBA - Bouton lister fichiers et bouton renommer ces fichiers

Titi456

XLDnaute Junior
Bonjour,

Je recherche un code à mettre sur deux boutons; le premier pour pouvoir lister (en colonne A) les fichiers d'un dossier que je pourrais sélectionner depuis un explorateur de fichiers et le second pour pouvoir renommer ces mêmes fichiers par rapport aux noms que j'aurais moi même indiqués dans la colonne B.

Pouvez-vous m'aider?

Mes meilleures salutations.

Thierry
 

Pièces jointes

  • Renommer fichiers.xlsx
    13.8 KB · Affichages: 3
Dernière édition:
Solution
Bonjour Titi,
Un essai en PJ avec :
Liste fichiers :
VB:
Sub ListerFichiers()
    Dim Chemin$, Fichier$, Ligne%
    Application.ScreenUpdating = False
    Chemin = [D2]             'Définit le répertoire contenant les fichiers
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Chemin & "*")
    [A:B].ClearContents: Ligne = 1 ' Efface données et Init pointeur écriture
    Do While Len(Fichier) > 0
        'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
        Cells(Ligne, "A") = Fichier: Ligne = Ligne + 1
        Fichier = Dir()
    Loop
End Sub
Renomme fichiers :
Code:
Sub RenommerFichiers()
    Dim DL%, L%, Chemin$
    Application.ScreenUpdating = False
    DL = [A65500].End(xlUp).Row: Chemin = [D2] ' Récupère...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Titi,
Un essai en PJ avec :
Liste fichiers :
VB:
Sub ListerFichiers()
    Dim Chemin$, Fichier$, Ligne%
    Application.ScreenUpdating = False
    Chemin = [D2]             'Définit le répertoire contenant les fichiers
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Chemin & "*")
    [A:B].ClearContents: Ligne = 1 ' Efface données et Init pointeur écriture
    Do While Len(Fichier) > 0
        'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
        Cells(Ligne, "A") = Fichier: Ligne = Ligne + 1
        Fichier = Dir()
    Loop
End Sub
Renomme fichiers :
Code:
Sub RenommerFichiers()
    Dim DL%, L%, Chemin$
    Application.ScreenUpdating = False
    DL = [A65500].End(xlUp).Row: Chemin = [D2] ' Récupère chemin
    For L = 1 To DL
        If Cells(L, "B") <> "" Then
            Name Chemin & Cells(L, "A") As Chemin & Cells(L, "B") ' On renomme le fichier
        End If
    Next L
    [A:B].ClearContents ' On efface les données
    ListerFichiers      ' On remet à jour la liste des fichiers
End Sub
 

Pièces jointes

  • Renommer fichiers.xlsm
    18.4 KB · Affichages: 9

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Avez vous valider les macros ?
Car ce fichier devrait fonctionner normalement :
20230907_083819.gif
 

Discussions similaires

Statistiques des forums

Discussions
312 206
Messages
2 086 220
Membres
103 158
dernier inscrit
laufin