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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
Sub Etat_Annee_Prochaine()
'
''Exporter les colonnes et la valeur du filtre Priorités + valeurs du fichier EnTete
' Etape 1 : Déclarer les fichiers sans Chemin d'accès, car tous dans le même répertoire
Dim Chemin As String, FichierDestinataire As String, NouveauFichier As String
Chemin = ThisWorkbook.Path & "\"
FichierSource = ThisWorkbook.Name
FichierDestinataire = "Rapport_AnneeProchaine.xls"
NouveauFichier = "Rapport_AnneeProchaine_" & Format(Date, "dd-mmmm-yyyy") & "_" & Format(Time, "hh-mm-ss") & ".xls"
' Etape 2 : Ouvrir le 2eme fichiers (cible), le 1er est déjà ouvert (Origine) car c'est celui de la macro
Workbooks.Open Chemin & FichierDestinataire
' Etape3 : Déclarer les feuilles de travail
Dim Source As Workbook, Destinataire As Workbook
Dim ActionDatabase As Worksheet, BoutonMacro As Worksheet, Departements As Range, DepartementsCible As Range, Cible As Worksheet, EnTete As Worksheet
Set Source = ThisWorkbook
Set ActionDatabase = Source.Sheets("Action Database")
Set BoutonMacro = Source.Sheets("Rapports")
Set Departements = Source.Sheets("Data Craponne").Columns("I:I")
Set Destinataire = Workbooks("Rapport_AnneeProchaine")
Set Cible = Destinataire.Sheets("Cible")
Set EnTete = Destinataire.Sheets("EnTete")
Set DepartementsCible = Destinataire.Sheets("EnTete").Columns("H:H")
Windows(FichierSource).Activate 'action nécessaire
'Etape 4 : Pour injecter dans la table à filtrer (Celule du filtre dan Action Database), la sélection des "priorités" dont on souhaite le rapport
ActionDatabase.Range("BS2") = BoutonMacro.Range("C17")
ActionDatabase.Range("BS3") = BoutonMacro.Range("C18")
ActionDatabase.Range("BS4") = BoutonMacro.Range("C19")
ActionDatabase.Activate
' Etape 5 : Exporter les valeurs des colonnes du Rapport des Status (Filtre)
Range("A1:BC1000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("BS1:BU4"), CopyToRange:=Cible.Range("A1:N1"), Unique:=False
' Etape 6 : Puis, copier de Origine vers Cible-onglet EnTete, la valeur des Priorités saisies et de la date de l'export, pour les intégrer à l'en-tête et copier la lise des départements
EnTete.Range("A2") = ActionDatabase.Range("BS2")
EnTete.Range("A3") = ActionDatabase.Range("BS3")
EnTete.Range("A4") = ActionDatabase.Range("BS4")
EnTete.Range("C2") = ActionDatabase.Range("BR2")
Departements.Copy DepartementsCible
' Etape 7 : Mises en forme
Cible.Activate
With Cible
' Mise en forme du tableau
' Réglage des largeurs de colonne
Cible.Columns("A:A").ColumnWidth = 10
Cible.Columns("B:B").ColumnWidth = 50
Cible.Columns("C:C").ColumnWidth = 35
Cible.Columns("D:D").ColumnWidth = 35
Cible.Columns("E:E").ColumnWidth = 10
Cible.Columns("F:F").ColumnWidth = 15
Cible.Columns("G:G").ColumnWidth = 9
Cible.Columns("H:H").ColumnWidth = 11
Cible.Columns("I:I").ColumnWidth = 15
Cible.Columns("J:J").ColumnWidth = 9
Cible.Columns("K:K").ColumnWidth = 7
Cible.Columns("L:L").ColumnWidth = 23
Cible.Columns("M:M").ColumnWidth = 50
Cible.Columns("N:N").ColumnWidth = 17
' Réglage de la police
Cells.Select
With Selection.Font
.Name = "Calibri"
.Size = 10
End With
' Colorier les lignes des actions 2017 et plus
Dim Ligne As Long, PlageLigne As Variant
Dim ActionNumber As Variant
Dim DueDate As Variant, Annee As Variant, SelectionAnnee As Variant
SelectionAnnee = Source.Sheets("Rapports").Cells(25, 3) 'Seletion de l'année de referrence - Seule ligne differente de celle du fichier test
For Ligne = 2 To Rows.Count
Set ActionNumber = Cells(Ligne, 1)
Set PlageLigne = Range("A" & Ligne, "N" & Ligne)
DueDate = Cells(Ligne, 5)
Annee = Year(DueDate) 'BUG = Erreur 13 - incompatibilité de type
If ActionNumber = "" Then
Exit For ' pour sortir de cette routine FOR...NEXT
Else
If Annee >= SelectionAnnee Then
PlageLigne.Interior.Color = RGB(255, 224, 192)
End If
End If
Next Ligne
' Ajustement des hauteurs de ligne au texte
Cells.EntireRow.AutoFit
' Réglage format pge marges zoom et en-tête
With Cible.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.236220472440945)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
' Réglage de l'en-tête du rapport
Dim Police As Variant, Taille As Integer
Police = "Arial"
'Taille = 20 'comment utilisr la variables taille ?
' Imprimer la 1ere ligne sur toutes les pages
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
'Mettre l'en-tête de l'impression
Dim CentreEnTete As Variant, GaucheEnTete As Variant
GaucheEnTete = EnTete.Range("B6")
CentreEnTete = EnTete.Range("B7")
.CenterHeader = "&""" & Police & """&20" & CentreEnTete 'comment utilisr la variables taille ?
.LeftHeader = "&""" & Police & """&20" & GaucheEnTete
'Pour terminer l'enchainement sur la cellule A1 du rapport
Cible.Range("A1").Select
End With
End With
' Etape 7 : Sauvegarder sous le nom défini pour NouveauFichier
Destinataire.SaveAs Chemin & NouveauFichier
'
End Sub |
