OVH Cloud OVH Cloud

macro en boucle sur 30 fichiers

5 réponses
Avatar
Érico
Bonjour à tous,

J'aimerais avoir une macro qui va exécuter toujours les mêmes modifications
dans un même répertoire.

Ouvrir le fichier
Faire les modification
enregistrer le fichier
Fermer ce fichier
Ouvrir le suivant
etc...


J'en ai environ une trentaine.

Merci

Érico de Montréal (il est 11:53 et il pleut)

5 réponses

Avatar
Daniel
Bonjour.
Regard l'aide sur l'instruction Dir.
Cordialement.
Daniel
"Érico" a écrit dans le message de news:

Bonjour à tous,

J'aimerais avoir une macro qui va exécuter toujours les mêmes
modifications dans un même répertoire.

Ouvrir le fichier
Faire les modification
enregistrer le fichier
Fermer ce fichier
Ouvrir le suivant
etc...


J'en ai environ une trentaine.

Merci

Érico de Montréal (il est 11:53 et il pleut)



Avatar
DesseJ
Bonjour, Bonsoir Erico,

Par exemple ce code. Seul restriction, le classeur qui contient la
macro à lancer doit se trouver dans le même dossier que tes classeurs
à traiter :

Sub TraitementFichiers()
Dim F
Dim NomFichier$, Chemin$, NomFichierTempo$
Call MonDebut
Chemin = ActiveWorkbook.Path
NomFichier = ActiveWorkbook.Name
With Application.FileSearch
.NewSearch
.LookIn = Chemin
.Execute
If .FoundFiles.Count = 1 Then Call MaFin: End
For Each F In .FoundFiles
NomFichierTempo = Right(F, Len(F) - Len(Chemin) - 1)
If NomFichierTempo <> NomFichier Then
Workbooks.Open F
Call TraitementDuClasseur(NomFichierTempo) 'Le
traitement du classeur
Workbooks(NomFichierTempo).Save
Workbooks(NomFichierTempo).Close
End If
Next F
End With
MsgBox "Traitement terminé !", vbYes, "Test / Test"
Call MaFin
End Sub

'---------------------------------
Sub TraitementDuClasseur(NomFichierTempo$)
MsgBox "Traitement du classeur : " & NomFichierTempo$, vbYes, "Test
/ Test"
End Sub

'---------------------------------
Sub MonDebut()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Application.Calculation = xlCalculationManual
End Sub
Sub MaFin()
'Application.Calculation = xlAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Avatar
Érico
Merci,

Mais, où je met ma macro?

Ma macro est dans un perso. C'Est vrai, je dois exécuter la macro dans un
fichier vierge?

Merci encore

"DesseJ" a écrit dans le message de news:

Bonjour, Bonsoir Erico,

Par exemple ce code. Seul restriction, le classeur qui contient la
macro à lancer doit se trouver dans le même dossier que tes classeurs
à traiter :

Sub TraitementFichiers()
Dim F
Dim NomFichier$, Chemin$, NomFichierTempo$
Call MonDebut
Chemin = ActiveWorkbook.Path
NomFichier = ActiveWorkbook.Name
With Application.FileSearch
.NewSearch
.LookIn = Chemin
.Execute
If .FoundFiles.Count = 1 Then Call MaFin: End
For Each F In .FoundFiles
NomFichierTempo = Right(F, Len(F) - Len(Chemin) - 1)
If NomFichierTempo <> NomFichier Then
Workbooks.Open F
Call TraitementDuClasseur(NomFichierTempo) 'Le
traitement du classeur
Workbooks(NomFichierTempo).Save
Workbooks(NomFichierTempo).Close
End If
Next F
End With
MsgBox "Traitement terminé !", vbYes, "Test / Test"
Call MaFin
End Sub

'---------------------------------
Sub TraitementDuClasseur(NomFichierTempo$)
MsgBox "Traitement du classeur : " & NomFichierTempo$, vbYes, "Test
/ Test"
End Sub

'---------------------------------
Sub MonDebut()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Application.Calculation = xlCalculationManual
End Sub
Sub MaFin()
'Application.Calculation = xlAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Avatar
DesseJ

Mais, où je met ma macro?
Ma macro est dans un perso. C'Est vrai, je dois exécuter la macro dans un
fichier vierge?



Bonjour,

Tu colles le code suivant dans ton perso.xls ;
Tu remplaces TraitementDuClasseur par le nom de ta macro ;
Tu lances la macro TraitementFichiers qui va t'ouvrir une fenêtre
explorateur dans laquelle tu sélectionnes un de tes classeurs du
répertoire à traiter. Et ça roule.

Bonne journée
Steph D.

'---------------------------------
Sub TraitementFichiers()
Dim F
Dim NomFichier$, Chemin$, NomFichierTempo$, CheminEtFichier$
Dim i#
Call MonDebut
CheminEtFichier = Application.GetOpenFilename
If CheminEtFichier = "False" Or CheminEtFichier = "Faux" Then
MaFin: End
For i = Len(CheminEtFichier) To 1 Step -1
If Mid$(CheminEtFichier, i, 1) = "" Then Exit For
Next
NomFichier = Mid$(CheminEtFichier, i + 1)
Chemin = Left(CheminEtFichier, InStr(1, CheminEtFichier,
NomFichier) - 2)
With Application.FileSearch
.NewSearch
.LookIn = Chemin
.FileType = msoFileTypeExcelWorkbooks
.Execute
If .FoundFiles.Count = 1 Then Call MaFin: End
For Each F In .FoundFiles
NomFichierTempo = Right(F, Len(F) - Len(Chemin) - 1)
Workbooks.Open F
Call TraitementDuClasseur(NomFichierTempo) 'Le traitement
du classeur
Workbooks(NomFichierTempo).Close SaveChanges:=True
Next F
End With
MsgBox "Traitement terminé !", vbYes, "Test / Test"
Call MaFin
End Sub

'---------------------------------
Sub TraitementDuClasseur(NomFichierTempo$)
MsgBox "Traitement du classeur : " & NomFichierTempo$, vbYes,
"Test"
End Sub

'---------------------------------
Sub MonDebut()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Application.Calculation = xlCalculationManual
End Sub
Sub MaFin()
'Application.Calculation = xlAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Avatar
Érico
Salut Steph,

Je crois l'avoir eu, sauf que j'ai le problème suivant:

Quand il ouvre chacun des fichiers et exécute la macro, ça lui prend un
temps fou.

Est-il possible d'éviter d'exécuter une macro que j'ai déjà mis dans chacun
des fichiers.

Cette macro fais juste d'aller dans le bon onglet et de refaire l'affichage.

J'aimerais éviter d'Avoir la question au début si je veux vraiment modifier
le fichier.

Merci







___________________________________________



Sub TraitementFichiers()

Dim F

Dim NomFichier$, Chemin$, NomFichierTempo$, CheminEtFichier$

Call MonDebut

CheminEtFichier = Application.GetOpenFilename

If CheminEtFichier = "False" Or CheminEtFichier = "Faux" Then MaFin: End

For i = Len(CheminEtFichier) To 1 Step -1

If Mid$(CheminEtFichier, i, 1) = "" Then Exit For

Next

NomFichier = Mid$(CheminEtFichier, i + 1)

Chemin = Left(CheminEtFichier, InStr(1, CheminEtFichier, NomFichier) - 2)

With Application.FileSearch

.NewSearch

.LookIn = Chemin

.FileType = msoFileTypeExcelWorkbooks

.Execute

If .FoundFiles.Count = 1 Then Call MaFin: End

For Each F In .FoundFiles

NomFichierTempo = Right(F, Len(F) - Len(Chemin) - 1)

Workbooks.Open F

Call Agence(NomFichierTempo) 'Le traitement du classeur

Workbooks(NomFichierTempo).Close SaveChanges:=True

Next F

End With

MsgBox "Traitement terminé !", vbYes, "Test / Test"

Call MaFin

End Sub

'---------------------------------

Sub Agence(NomFichierTempo$)

MsgBox "Traitement du classeur : " & NomFichierTempo$, vbYes, "Test"

Sheets("Annexe_1.1b").Select

With ActiveSheet.PageSetup

.PrintTitleRows = "$1:$15"

.PrintTitleColumns = ""

End With

ActiveSheet.PageSetup.PrintArea = "$A$1:$BJ$192"

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = _

"&""Times New Roman,Gras italique""Agence de la santé et des services
sociaux de Montréal"

.CenterFooter = "&""Times New Roman,Gras italique""Imprimé le &D"

.RightFooter = "&""Times New Roman,Gras italique""Page &P de &N"

.LeftMargin = Application.InchesToPoints(0.196850393700787)

.RightMargin = Application.InchesToPoints(0.196850393700787)

.TopMargin = Application.InchesToPoints(0.275590551181102)

.BottomMargin = Application.InchesToPoints(0.47244094488189)

.HeaderMargin = Application.InchesToPoints(0.511811023622047)

.FooterMargin = Application.InchesToPoints(0.275590551181102)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintInPlace

.PrintQuality = 1200

.CenterHorizontally = True

.CenterVertically = False

.Orientation = xlLandscape

.Draft = False

.PaperSize = xlPaperLegal

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = False

.FitToPagesWide = 2

.FitToPagesTall = 1

End With

Sheets("Annexe_1.1c").Select

With ActiveSheet.PageSetup

.PrintTitleRows = "$1:$15"

.PrintTitleColumns = ""

End With

ActiveSheet.PageSetup.PrintArea = "$B$1:$P$177"

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = _

"&""Times New Roman,Gras italique""Agence de la santé et des services
sociaux de Montréal"

.CenterFooter = "&""Times New Roman,Gras italique""Imprimé le &D"

.RightFooter = "&""Times New Roman,Gras italique""Page &P de &N"

.LeftMargin = Application.InchesToPoints(0.393700787401575)

.RightMargin = Application.InchesToPoints(0.196850393700787)

.TopMargin = Application.InchesToPoints(0.275590551181102)

.BottomMargin = Application.InchesToPoints(0.47244094488189)

.HeaderMargin = Application.InchesToPoints(0.433070866141732)

.FooterMargin = Application.InchesToPoints(0.275590551181102)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintInPlace

.PrintQuality = 1200

.CenterHorizontally = True

.CenterVertically = False

.Orientation = xlLandscape

.Draft = False

.PaperSize = xlPaperLegal

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = False

.FitToPagesWide = 1

.FitToPagesTall = 8

End With

Sheets("Annexe_1.4").Select

With ActiveSheet.PageSetup

.PrintTitleRows = "$1:$13"

.PrintTitleColumns = ""

End With

ActiveSheet.PageSetup.PrintArea = "$B$1:$R$627"

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = _

"&""Times New Roman,Gras italique""Agence de la santé et des services
sociaux de Montréal"

.CenterFooter = "&""Times New Roman,Gras italique""Imprimé le &D"

.RightFooter = "&""Times New Roman,Gras italique""Page &P de &N"

.LeftMargin = Application.InchesToPoints(0.905511811023622)

.RightMargin = Application.InchesToPoints(0.78740157480315)

.TopMargin = Application.InchesToPoints(0.354330708661417)

.BottomMargin = Application.InchesToPoints(0.669291338582677)

.HeaderMargin = Application.InchesToPoints(0.31496062992126)

.FooterMargin = Application.InchesToPoints(0.236220472440945)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintNoComments

.PrintQuality = 600

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlLandscape

.Draft = False

.PaperSize = xlPaperLegal

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = False

.FitToPagesWide = 1

.FitToPagesTall = 24

End With

Sheets("Annexe_1.5").Select

With ActiveSheet.PageSetup

.PrintTitleRows = "$1:$13"

.PrintTitleColumns = ""

End With

ActiveSheet.PageSetup.PrintArea = "$B$1:$R$626"

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = _

"&""Times New Roman,Gras italique""Agence de la santé et des services
sociaux de Montréal"

.CenterFooter = "&""Times New Roman,Gras italique""Imprimé le &D"

.RightFooter = "&""Times New Roman,Gras italique""Page &P de &N"

.LeftMargin = Application.InchesToPoints(0.92)

.RightMargin = Application.InchesToPoints(0.78740157480315)

.TopMargin = Application.InchesToPoints(0.354330708661417)

.BottomMargin = Application.InchesToPoints(0.67)

.HeaderMargin = Application.InchesToPoints(0.31)

.FooterMargin = Application.InchesToPoints(0.23)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintNoComments

.PrintQuality = 600

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlLandscape

.Draft = False

.PaperSize = xlPaperLegal

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = False

.FitToPagesWide = 1

.FitToPagesTall = 24

End With

Sheets("Annexe_1.6").Select

With ActiveSheet.PageSetup

.PrintTitleRows = "$1:$15"

.PrintTitleColumns = ""

End With

ActiveSheet.PageSetup.PrintArea = "$B$1:$R$121"

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = ""

.RightHeader = ""

.LeftFooter = _

"&""Times New Roman,Gras italique""Agence de la santé et des services
sociaux de Montréal"

.CenterFooter = "&""Times New Roman,Gras italique""Imprimé le &D"

.RightFooter = "&""Times New Roman,Gras italique""Page &P de &N"

.LeftMargin = Application.InchesToPoints(0.196850393700787)

.RightMargin = Application.InchesToPoints(0.196850393700787)

.TopMargin = Application.InchesToPoints(0.275590551181102)

.BottomMargin = Application.InchesToPoints(0.47244094488189)

.HeaderMargin = Application.InchesToPoints(0.511811023622047)

.FooterMargin = Application.InchesToPoints(0.275590551181102)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintInPlace

.PrintQuality = 600

.CenterHorizontally = True

.CenterVertically = False

.Orientation = xlLandscape

.Draft = False

.PaperSize = xlPaperLegal

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = False

.FitToPagesWide = 1

.FitToPagesTall = 4

End With

Sheets("Annexe_1.7").Select

End Sub

'---------------------------------

Sub MonDebut()

Application.EnableEvents = False

Application.ScreenUpdating = False

Application.DisplayAlerts = False

'Application.Calculation = xlCalculationManual

End Sub

Sub MaFin()

'Application.Calculation = xlAutomatic

Application.EnableEvents = True

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub