Comment simplifier mon code VBA? [Résolu]

Messages postés
28
Date d'inscription
mercredi 1 février 2012
Dernière intervention
17 avril 2013
- - Dernière réponse : ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Contributeur
Dernière intervention
11 avril 2018
- 2 févr. 2012 à 19:54
Bonjour

J'ai "joué" aux apprentis sorciers en combinant des bouts de script glannées un peu partout.


Quelqu'un pourrait t il m'indiquer si il est possible de simplifier ce code :
En effet, ce code marche pour deux agences, le problème c'est que j'en ai 60, faut il refaire du copier coller ou pensez vous qu'il y a une solution plus simple.

Pour résumer mon code, j'ai un fichier avec au moins 180 fichiers
en général 3 fichiers correspondent à une agence donc j'ai 60 agence.
Agence alsace 1, agence alsace 2, agence alsace 3.
Je reussi à les dispatcher en 1 agence en format xlsx(erreur surtout quand les user on excel 2003..).
il reussi en parallele à enregistrer le doc en .PDF car en partant d une base général j avais des problemes de confidentialité car ils peuvent en filtre de rapport changer le nom de l'agence..
Et l'autre partie du code c'est pour la mise en page..

Ma question est, si je dois rajouter d'autres agences existe t-il un autre moyen que de copier coller les lignes correspondantes aux agences.

Sub test()
Application.DisplayAlerts = False
Sheets(Array("Agence ALSACE", "Agence ALSACE (2)", "Agence ALSACE (3)")).Copy
ActiveWorkbook.SaveAs "N:\Litiges\Test Automat\Litiges Agence ALSACE.xlsx"

Dim i As Integer
With ActiveWorkbook
For i = 1 To Sheets.Count
With Sheets(i).Cells
.Columns.AutoFit
.Rows.AutoFit
End With
Next i

ActiveWorkbook.Worksheets.Select
For Each xworksheet In ActiveWorkbook.Worksheets
xworksheet.Select
Range("F:F").ColumnWidth = 220
Range("F:F").WrapText = True

With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$4"
.PrintArea = "$A$4:$H$51"
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0)
.FitToPagesWide = 1
.FitToPagesTall = 1
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.Orientation = xlLandscape
.Zoom = False
End With
Next xworksheet

'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="N:\Litiges\Test Automat\Test.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "Fiche crée et database mise à jour"
End With

ActiveWorkbook.Close False
Application.DisplayAlerts = False
Sheets(Array("Agence Champagne Ardennes", "Agence Champagne Ardennes (2)", "Agence Champagne Ardennes (3)")).Copy
ActiveWorkbook.SaveAs "N:\Litiges\Test Automat\Litiges Agence Champagne Ardennes.xlsx"

'Dim i As Integer
With ActiveWorkbook
For i = 1 To Sheets.Count
With Sheets(i).Cells
.Columns.AutoFit
.Rows.AutoFit
End With
Next i

ActiveWorkbook.Worksheets.Select
For Each xworksheet In ActiveWorkbook.Worksheets
xworksheet.Select
Range("F:F").ColumnWidth = 220
Range("F:F").WrapText = True

With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$4"
.PrintArea = "$A$4:$H$51"
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0)
.FitToPagesWide = 1
.FitToPagesTall = 1
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.Orientation = xlLandscape
.Zoom = False
End With
Next xworksheet

'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="N:\Litiges\Test Automat\Agence Champagne Ardennes.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "Fiche crée et database mise à jour"
End With
ActiveWorkbook.Close False

End Sub


Merci d'avance !
Afficher la suite 

Votre réponse

2 réponses

Meilleure réponse
Messages postés
14323
Date d'inscription
vendredi 14 mars 2003
Dernière intervention
15 décembre 2018
3
Merci
Bonjour,

Commence par lire le point 2 de ma signature.
Ensuite, retuires tous les Select et autres Activate inutiles.
Tu peux aussi désativer le rafraichissement de la fenêtre avec Application.ScreenUdating (je pense).

---------------------------------------------------------------------
[list=ordered][*]Pour poser correctement une question et optimiser vos chances d'obtenir des réponses, pensez à lire le règlement CS, ce lien ou encore celui-ci[*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : )
[*]Si votre problème est résolu (et uniquement si c'est le cas), pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés./list
---
Mon site

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources a aidé 98 internautes ce mois-ci

Commenter la réponse de NHenry
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Contributeur
Dernière intervention
11 avril 2018
3
Merci
Bonjour,

Je ne sais pas si j'ai tout compris, mais ... ==>>
Je dirais ceci :
1) savoir se débarrasser de ces "activate" au profit de pointages
2) passer les feuilles (objets, donc) en paramètre
3) si feuilles appartenant à des classeurs différents ===>> chercher une réponse très récente que j'ai faite à propos de l'utilisation d'une macro/fonction/procédure appartenant à un autre classeur.
Telle est ma réponse, à ce stade.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources a aidé 98 internautes ce mois-ci

Commenter la réponse de ucfoutu

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.