Macro avec condition sur extension

Jade108

XLDnaute Nouveau
Bonjour à tous,

Je débute avec les macros Excel, donc j'ai fait des recherches pour mon besoin et j'ai réussi à faire une macro à base de copier/coller de bouts de macros.

Ce que je souhaite faire :
Ouvrir une boite de dialogue pour selectionner le repertoire à traiter
Dans ce repertoire,
balayer tous les fichiers de ce repertoire et des sous repertoires
rajouter le pied de page "CONFIDENTIEL", enregistrer sous le meme nom et fermer

J'ai réussi à faire une macro qui fonctionne.

Le probleme est que dans mes repertoires il y a des fichiers autres que .xls*, donc il faut que j'ajoute une condition sur l'extension du document (dans un premier temps, je ne traite que les fichiers Excel. Je me poserai la question plus tard pour Word et Powerpoint)

Du coup, j'ai rajouté une condition sur l'extension de mon fichier, mais là, ça ne marche plus très bien.
J'espère que quelqu'un pourra me conseiller.

Merci par avance !

Ci-dessous ma macro :


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



For Each Rep In Dossier.SubFolders
Modif_Dossier Rep


For Each f2 In Rep.Files
'If Right(f2.Name, 4) = ".xls*" Then

Set wb = Workbooks.Open(f2)

With ActiveSheet.PageSetup
.CenterFooter = "CONFIDENTIEL"
End With

Application.PrintCommunication = True
ActiveWindow.View = xlNormalView
ActiveWorkbook.Save

wb.Close True

Next f2

Next



End Sub
 

Efgé

XLDnaute Barbatruc
Re : Macro avec condition sur extension

Bonjour Jade108 et bienvenu sur le forum

Une modification du code :

Tu ne peux pas utiliser * de cette manière, il faut utiliser Like.
En utilisant la fonction Split, on récupère directement l’extension du fichier qu l'on peux comparer grace au Like
VB:
Sub Modif_Dossier(ByRef Dossier)
Dim Rep As Object
Dim f2 As Object, wb As Workbook
Dim T As Variant
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)
            wb.ActiveSheet.PageSetup.CenterFooter = "CONFIDENTIEL"
            'Application.PrintCommunication = True ' Je ne vois pas l'interet de cette ligne
            'ActiveWindow.View = xlNormalView ' Je ne vois pas l'interet de cette ligne
            wb.Close True 'en indiquant true on sauvegarde avant de fermer
        End If
    Next f2
Next Rep
End Sub

Cordialement
 

Jade108

XLDnaute Nouveau
Re : Macro avec condition sur extension

Un grand merci à toi !

Du coup, je peux partir de cette base pour pouvoir traiter mes fichiers Word et Powerpoint ? ou est-ce plus compliqué que çà ?

En tous cas, merci beaucoup, çà faisait un moment que je bloquais là-dessus !
 

Efgé

XLDnaute Barbatruc
Re : Macro avec condition sur extension

Re
Je ne m'aventurerai pas sur la manipulation des Words et PowerPoint.
La gestion depuis Excel nécessite la création d'objet dédiés qui ne font pas partis de mes connaissances.
Cordialement
 

Jade108

XLDnaute Nouveau
Re : Macro avec condition sur extension

Bonjour Efgé !

Je viens de tester le code que tu m'a donné hier et en fait, il ne fonctione pas très bien car je me suis rendue compte que la boucle sur les repertoires ne se faisait pas : la macro tourne en boucle sur les fichiers d'un même repertoire et ne passe pas au repertoire suivant.
Je ne comprends pas pourquoi vu que la structure du code n'a pas changé... Sais-tu de quoi ça pourrait venir ?
 

Jade108

XLDnaute Nouveau
Re : Macro avec condition sur extension

J'ai l'impression que le probleme viendrait de cette ligne là :

wb.ActiveSheet.PageSetup.CenterFooter = "CONFIDENTIEL"

Du coup la macro part en boucle sur le repertoire en cours...
Quelqy'un saurait m'expliquer comment corriger ?

Merci par avance.
 

Efgé

XLDnaute Barbatruc
Re : Macro avec condition sur extension

Bonjour Jade108


Comme tu le dis toi même :
...la structure du code n'a pas changé...


Le seul problème que j'imagine est la présence de code dans les fichiers ouverts (soit dans le code la feuille active, soit dans le ThisWorkBook).
Normalement la gestion des "bas de page" est long, voir très long, comme l'ouverture de fichiers "lourds", mais ne génère pas de "boucle".
Essai comme ceci :
VB:
Sub Modif_Dossier_3(ByRef Dossier)
Dim Rep As Object
Dim f2 As Object, wb As Workbook
Dim T As Variant
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
            Application.EnableEvents = False ' on désactive les évennements sur les feuilles
            Set wb = Workbooks.Open(f2)
            wb.ActiveSheet.PageSetup.CenterFooter = "CONFIDENTIEL"
            wb.Close True
            Set wb = Nothing 'on supprime l'objet wb précédemment créé
       End If
    Next f2
Next Rep
Application.EnableEvents = True ' on réactive les évennements sur les feuilles
End Sub


Après, il faudrait voir l'environnement réel dans lequel tu travail, et ça... ...c'est hors champ ;-)


Cordialement
 

Jade108

XLDnaute Nouveau
Re : Macro avec condition sur extension

Quand tu parles de "code dans les fichiers ouverts" tu parles des fichiers sur lesquels je boucle ou de fichiers que je pourrais avoir laissé ouverts pendant que je fais ma macro ? Ou les 2 ?

Lors de mes tests j'avais effectivement d'autres fichiers excel, je vais refaire un test en ne gardant que ma macro ouverte.
Pour mes tests, j'ai créé une arborescence pas trop complexe avec des fichiers basiques dans lesquels il n'y a pas de macro donc il ne devrait pas y avoir d'"interférence".

Je vais refaire le test avec ta nouvelle proposition et te tiens au courant.
 

Jade108

XLDnaute Nouveau
Re : Macro avec condition sur extension

Bon, je ne vais pas crier victoire trop vite, mais ça a l'air de marcher.

Je referai un test "grandeur nature" Jeudi avec des vrais fichiers et te confirmerai çà.
En tous cas, merci d'avoir pris le temps de regarder mon probleme.

Bonne soirée à toi.
 

Jade108

XLDnaute Nouveau
Re : Macro avec condition sur extension

Test de ce matin non concluant : la macro se remet à boucler sur 1 seul répertoire...

Il doit se passer un truc du genre à partir de minuit la macro se met en mode bug, un peu façon Gremlins...
Je vais retenter avec une structure de répertoire plus simple, sans grande conviction...
 

Jade108

XLDnaute Nouveau
Re : Macro avec condition sur extension

Je viens de refaire le test en "masquant" la partie où on insère "confidentiel" sur les onglets (j'ai rajouté une boucle sur les onglets d'ailleurs, mais le probleme existe quand même sans la boucle), et là, la macro boucle bien sur tous les repertoires :

Code:
Sub Modif_Dossier_3(ByRef Dossier)
Dim Rep As Object
Dim f2 As Object, wb As Workbook
Dim T As Variant
For Each Rep In Dossier.SubFolders
Dim I As Integer
Dim WS_Count As Integer

     Modif_Dossier_3 Rep
     For Each f2 In Rep.Files
         T = Split(f2.Name, ".")
         If T(UBound(T)) Like "xl*" Then
             Application.EnableEvents = False ' on désactive les évennements sur les feuilles
            Set wb = Workbooks.Open(f2, UpdateLinks:=False)
            
            'WS_Count = wb.Worksheets.Count                        'Boucle sur les onglets
            ' For I = 1 To WS_Count                                           'Boucle sur les onglets
            'wb.Worksheets(I).PageSetup.CenterFooter = "CONFIDENTIEL 2"                 'Boucle sur les onglets
            ' Next I                                                                       'Boucle sur les onglets

                          
             ActiveWorkbook.CheckCompatibility = False
             wb.Close True
             Set wb = Nothing 'on supprime l'objet wb précédemment créé
       End If
     Next f2
Next Rep
 Application.EnableEvents = True ' on réactive les évennements sur les feuilles
End Sub

Je me demandais s'il ne faudrait pas mettre des variables pour les repertoires et les fichiers, du genre :
pour chaque onglet i, de chaque fichier j, de chaque repertoire r modifier le pied de page ; et à chaque fois on incrémente i, puis j puis r ?
 
Dernière édition:

Efgé

XLDnaute Barbatruc
Re : Macro avec condition sur extension

Bonjour Jade108
Je ne pense vraiment pas que le problème vienne de la modification du Page setup de tes onglets.
Ce qui est intéressant à constater, c'est que tout va bien lorsque tu es en environnement de test(a première vue sur ton PC) et que tout dysfonctionne dans ton environnement de prod.
Vérifie que tes classeurs de prod ne possèdent pas un mot de passe, ou que tu as bien tous les droits d'accès sur le repertoire, voir même si certains dossiers ne sont pas en "écriture seule".
Pour résoudre le cas il faut avoir accès aux vrais fichiers, donc ce sera ma dernière intervention.

Cordialement
 

Discussions similaires

Réponses
2
Affichages
395
Réponses
4
Affichages
196
Haut Bas