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 |
Partager