Comment Simplifiemon code VBA ???

[grod]

Je rebondis sur moi même pour le sujet : 10 fichiers de x onglets issus d'un fichier de plusieurs onglets... et ouvre un autre topic.


Point 2 : J'ai trouvé (merci les forums) des solutions pour generer la mise en page souhaité.
Point 3 et 4: n'arrivant pas à trouver de réponse j'ai décidé de contourner le problème en generant des Pdf (ce qui securisera les données et rendra possible la lecture du document pour ceux qui n'avat pas Excel 2007) .

Par contre, j'ai "joué" aux apprentis sorciers en combinant des bouts de requetes glannées un peu partout.


Quelqu'un pourrait t il m'indiquer si il est possible de simplifier ce code :

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


Je reproduis ma ligne de code pour 2 agences, mais la liste etant assez longue, je cherche à trouver un code "light"..



merci.

 

[Philippe68]

Re : Comment Simplifiemon code VBA ???

Bonsoir,

Pas de salutations, de svp, mais un merci.... l'honneur est sauf.
Un petit passage par ici Lien supprimé s'impose