Comment simplifier mon code VBA? [Résolu]

anthooooony 28 Messages postés mercredi 1 février 2012Date d'inscription 17 avril 2013 Dernière intervention - 2 févr. 2012 à 18:51 - Dernière réponse : ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionContributeurStatut 11 avril 2018 Dernière intervention
- 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
NHenry 14229 Messages postés vendredi 14 mars 2003Date d'inscription 14 juillet 2018 Dernière intervention - 2 févr. 2012 à 19:44
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

Merci NHenry 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 87 internautes ce mois-ci

Commenter la réponse de NHenry
Meilleure réponse
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionContributeurStatut 11 avril 2018 Dernière intervention - 2 févr. 2012 à 19:54
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

Merci ucfoutu 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 87 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.