Sujet Précédent Sujet Suivant

Comment simplifier mon code VBA?

Résolu
anthooooony Messages postés 28 Date d'inscription mercredi 1 février 2012 Statut Membre Dernière intervention 17 avril 2013 - 2 févr. 2012 à 18:51
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur 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 !

2 réponses

Réponse 1 / 2
NHenry Messages postés 15069 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 29 mai 2023 158
2 févr. 2012 à 19:44
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
3
Réponse 2 / 2
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 219
2 févr. 2012 à 19:54
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
3
Rejoignez-nous