Boucle For Each... infinie
Jade108
Messages postés
6
Date d'inscription
Statut
Membre
Dernière intervention
-
Jade108 Messages postés 6 Date d'inscription Statut Membre Dernière intervention -
Jade108 Messages postés 6 Date d'inscription Statut Membre Dernière intervention -
Bonjour à tous,
Je cherche à intégrer de manière atomatique un pied de page sur tous les onglets de tous les fichiers .xl* de tous les sous répertoires d'un repertoire donné.
J'ai donc un code avec des boucles imbriquées.
Le problème est que la macro boucle sur les fichiers du 1er repertoire sans s'arrêter et ne passe pas au suivant.
Il me semblait pourtant avoir fait un test hier qui fonctionnait mais je n'arrive pas à refaire un test concluant.
Si quelqu'un peut m'aider à trouver mon erreur, ce serait gentil.
Merci par avance !
Sub test()
Dim Chemin As String
Dim Ws As Worksheet
Dim I As Integer
Dim Fso As Object
Dim Dossier_Principal
Dim FdFolder As FileDialog
Set FdFolder = Application.FileDialog(msoFileDialogFolderPicker)
With FdFolder
If .Show = -1 Then ' Clic sur Ok
Chemin = .SelectedItems(1)
Else ' Clic sur Annuler
Exit Sub
End If
End With
Set FdFolder = Nothing
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Dossier_Principal = Fso.getfolder(Chemin)
Modif_Dossier Dossier_Principal
End Sub
Sub Modif_Dossier(ByRef Dossier)
Dim Rep As Object
Dim f2 As Object, wb As Workbook
Dim T As Variant
Dim Sheet As Integer
For Each Rep In Dossier.SubFolders
Modif_Dossier Rep
For Each f2 In Rep.Files
T = Split(f2.Name, ".")
If T(UBound(T)) Like "xl*" Then
Set wb = Workbooks.Open(f2, UpdateLinks:=False)
WS_Count = wb.Worksheets.Count
For Sheet = 1 To WS_Count
wb.Worksheets(Sheet).PageSetup.CenterFooter = "CONFIDENTIEL"
Next Sheet
ActiveWorkbook.CheckCompatibility = False
wb.Close True
End If
Next f2
Next Rep
End Sub
Je cherche à intégrer de manière atomatique un pied de page sur tous les onglets de tous les fichiers .xl* de tous les sous répertoires d'un repertoire donné.
J'ai donc un code avec des boucles imbriquées.
Le problème est que la macro boucle sur les fichiers du 1er repertoire sans s'arrêter et ne passe pas au suivant.
Il me semblait pourtant avoir fait un test hier qui fonctionnait mais je n'arrive pas à refaire un test concluant.
Si quelqu'un peut m'aider à trouver mon erreur, ce serait gentil.
Merci par avance !
Sub test()
Dim Chemin As String
Dim Ws As Worksheet
Dim I As Integer
Dim Fso As Object
Dim Dossier_Principal
Dim FdFolder As FileDialog
Set FdFolder = Application.FileDialog(msoFileDialogFolderPicker)
With FdFolder
If .Show = -1 Then ' Clic sur Ok
Chemin = .SelectedItems(1)
Else ' Clic sur Annuler
Exit Sub
End If
End With
Set FdFolder = Nothing
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Dossier_Principal = Fso.getfolder(Chemin)
Modif_Dossier Dossier_Principal
End Sub
Sub Modif_Dossier(ByRef Dossier)
Dim Rep As Object
Dim f2 As Object, wb As Workbook
Dim T As Variant
Dim Sheet As Integer
For Each Rep In Dossier.SubFolders
Modif_Dossier Rep
For Each f2 In Rep.Files
T = Split(f2.Name, ".")
If T(UBound(T)) Like "xl*" Then
Set wb = Workbooks.Open(f2, UpdateLinks:=False)
WS_Count = wb.Worksheets.Count
For Sheet = 1 To WS_Count
wb.Worksheets(Sheet).PageSetup.CenterFooter = "CONFIDENTIEL"
Next Sheet
ActiveWorkbook.CheckCompatibility = False
wb.Close True
End If
Next f2
Next Rep
End Sub
A voir également:
- Boucle For Each... infinie
- Downloader for pc - Télécharger - Téléchargement & Transfert
- Idm for mac - Télécharger - Téléchargement & Transfert
- Copytrans heic for windows - Télécharger - Visionnage & Diaporama
- Instagram for pc - Télécharger - Divers Communication
- Microsoft store download for pc - Guide