Effectuer macro sur fichiers d'un répertoire
Bonjour,
J'aurais besoin de votre aide ! J'ai tout essayé et je n'arrive pas à trouver l'erreur
Mon objectif : Parcourir TOUS les fichiers d'un répertoire et y appliquer une macro (Macro recherche et remplace qui n'est pas compliquée) pour ensuite SAUVEGARDER ces modifications soit sur le même fichier ou soit dans un autre fichier.
Voici le code que j'ai trouvé qui me permet de boucler sur l'ensemble des fichiers du répertoire :
Mon code est le suivant :
Sub BoucleFichiers()
Dim Chemin As String, Fichier As String
'Définit le répertoire contenant les fichiers
Chemin = "C:\Users\U329092\Music\Test\"
'Boucle sur tous les fichiers xls du répertoire.
Fichier = Dir(Chemin & "*.xls")
'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers:
'Fichier = Dir(Chemin & "*.*")
Do While Len(Fichier) > 0
'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
Fichier.Open
Call traduction
Debug.Print Chemin & Fichier
Chemin2 = "C:\Users\U329092\Music\Test1\" 'Ouverture d'un autre répertoire existant'
unFichier = "NomClasseur_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xls"
ActiveWorkbook.SaveCopyAs Chemin2 & unFichier 'Sauvegarde du fichier crée dans ce répertoire existant'
Fichier = Dir()
Loop
End Sub
Ma problématique : "traduction" étant ma macro, celle-ci ne s'effectue que sur le fichier sur lequel je lance ma macro !! Exemple : J'ai 5 fichiers dans un répertoire, ce code parcours bien les 5 fichiers et sauvegarde 5 fichiers dans un répertoire différent. Cependant, ces 5 fichiers restent IDENTIQUES et ne correspondent pas aux fichiers originaux "traduits" (Mon but final étant de traduire automatiquement des fichiers). Je ne parviens pas à EFFECTUER ma macro sur les fichiers mais seulement sur celui dont je lance ma macro.
Je me doute que mon erreur se trouve sur la boucle "For each" mais je ne vois pas comment m'en sortir !!
Merci d'avance pour votre préciseuse aide
Jordan
Bonjour Jordan,
voici un exemple à tester,
la variable wk est déclaré dans le haut du module, ce qui permet de l'utiliser dans la macro traduction
Dim wk As Workbook
Sub Liste_des_fichiers2()
Dim Chemin As String, Fichier As String
Chemin = "C:\Users\U329092\Music\Test\"
Fichier = Dir(Chemin & "*.xls*")
Do While Len(Fichier) > 0
Workbooks.Open Filename:=Chemin & Fichier
Set wk = ActiveWorkbook
Call traduction
Chemin2 = "C:\Users\U329092\Music\Test1\" 'Ouverture d'un autre répertoire existant'
unFichier = "NomClasseur_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xls"
wk.SaveCopyAs Chemin2 & unFichier 'Sauvegarde du fichier crée dans ce répertoire existant'
' Fermer le fichier original sans l'enregistrer, n'entraîne pas l'exécution d'une macro AutoClose dans le classeur
wk.Close SaveChanges:=False
'prochain fichier
Fichier = Dir()
Loop
End Sub
Sub traduction()
MsgBox wk.Name
End Sub
Bonjour,
Ou alors, dans le même esprit que sabV que je salut au passage
Sub BoucleFichiers()
Dim Cls As Workbook
Dim Chemin As String
Dim Chemin2 As String
Dim Fichier As String
Dim unFichier As String
'Définit le répertoire contenant les fichiers
Chemin = "C:\Users\U329092\Music\Test\"
'Boucle sur tous les fichiers xls du répertoire.
Fichier = Dir(Chemin & "*.xls")
'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers:
'Fichier = Dir(Chemin & "*.*")
Do While Len(Fichier) > 0
'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
Set Cls = Workbooks.Open(Chemin & Fichier)
Traduction Cls
Debug.Print Chemin & Fichier
Chemin2 = "C:\Users\U329092\Music\Test1\" 'Ouverture d'un autre répertoire existant'
unFichier = "NomClasseur_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xls"
Cls.SaveCopyAs Chemin2 & unFichier 'Sauvegarde du fichier crée dans ce répertoire existant'
Cls.Close False
Fichier = Dir()
Loop
End Sub
Sub Traduction(Classeur As Workbook)
MsgBox Classeur.Name
End Sub
Bonjour,
Ca marche nickel !!!
Merci beaucoup de votre aide !!!!
Merci pour ce retour, au plaisir!
si le problème est résolu, s.v.p. pour clôturer le fil, cliquer sur le bouton V vert du post à coté du bouton EDITER, merci!