1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
| Sub Macro2()
'
' Macro2 Macro
'
' Touche de raccourci du clavier: Ctrl+b
'
'Déclarations
Dim oApp As Excel.Application
Dim Fichier As Excel.Workbook
Dim OnglMois1 As Worksheet, OnglMois2 As Worksheet, OnglMois3 As Worksheet, OnglMois4 As Worksheet, OnglMois5 As Worksheet, OnglMois6 As Worksheet
Dim Recap As Worksheet
Set oApp = CreateObject("Excel.Application")
Set Recap = ThisWorkbook.Worksheets("Récap")
Set Fichier = oApp.Workbooks.Open("N:\Mondossier\CAL.xls")
Set OnglMois1 = Fichier.Worksheets("Nov 11")
Set OnglMois2 = Fichier.Worksheets("Déc 11")
Set OnglMois3 = Fichier.Worksheets("Janv 12")
Set OnglMois4 = Fichier.Worksheets("Févr 12 ")
Set OnglMois5 = Fichier.Worksheets("Mars 12")
Set OnglMois6 = Fichier.Worksheets("Avril 12")
OnglMois1.Range("A2:AI5").Copy
Recap.Paste Destination:=Recap.Cells(1, 1)
'Application.CutCopyMode = False
OnglMois2.Range("A2:AI5").Copy
Recap.Paste Destination:=Recap.Cells(5, 1)
'Application.CutCopyMode = False
OnglMois3.Range("A2:AI5").Copy
Recap.Paste Destination:=Recap.Cells(9, 1)
'Application.CutCopyMode = False
OnglMois4.Range("A2:AI5").Copy
Recap.Paste Destination:=Recap.Cells(13, 1)
'Application.CutCopyMode = False
OnglMois5.Range("A2:AI5").Copy
Recap.Paste Destination:=Recap.Cells(17, 1)
'Application.CutCopyMode = False
OnglMois6.Range("A2:AI5").Copy
Recap.Paste Destination:=Recap.Cells(21, 1)
Application.CutCopyMode = False
'Annule toutes les alertes Excel
Application.DisplayAlerts = False
Application.CutCopyMode = False
Fichier.Close False
'Restaure l'affichage des Alertes
Application.DisplayAlerts = True
Recap.Range("E:AI").ColumnWidth = 15
Recap.Range("3:4,7:8,11:12,15:16,19:20,23:24").RowHeight = 175
Recap.PageSetup.PrintArea = "$A$1:$AI$24"
With ActiveSheet.PageSetup
'Définition des marges
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.2)
.BottomMargin = Application.InchesToPoints(0.2)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
'Pour ajuster sur une page
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
'Pour imprimer en paysage
.Orientation = xlLandscape
'.PrintQuality = 600
'.Draft = False
End With
ActiveWindow.SelectedSheets.PrintPreview
End Sub |
Partager