Booster une macro

NektarMinuit

XLDnaute Nouveau
Bonjour à vous tous,
Je suis en tain de peaufiner uen macro assez lourde et même si le traitement s'execute en moins de deux minutes.
Je vous joins le langage en espèrant que cela puisse être suffisant :)
Simple nota bene qui a toute son importance : je suis novice !!!!
Merci à tous ceux qui y jeteraient un oeil et à ceux qui voudraient bien m'aider!!!!
NM

'Déclarations des noms des feuilles excel
Private Const name_TCD_seq As String = "TCD_Séquences"
Private Const name_GCD_seq As String = "Graph_Séquences"
Private Const name_TCD_annee_en_cours As String = "TCD_Année_en_cours"
Private Const name_GCD_annee_en_cours As String = "Graph_Année_en_cours"
Private Const name_TCD As String = "TCD_Suivi_heures"

' Déclaration des variables de traitement de la macro

Private gmp_Path ' Chemin d'accès vers l'extraction GMP Charge
Private ref_Path ' Chemin d'accès vers l'extraction de réfèrence
Private p14_Path ' Chemin d'accès au fichier P14
Private ligneFin As Long 'entier qui définit le nombre de ligne pour traitement
Private nbLigne_GMP As Long 'entier qui définit le nombre de ligne du GMP
Private nbLigne_p14 As Long 'entier qui définit le nombre de ligne du projet 14
Private nbLigne_total As Long 'entier qui définit le nombre de ligne du GMP + Projet 14 avec entêtes
Private colonneFin As Long ' entier qui définit la colonne de fin
Private gmp_charge_FileName ' nom du fichier de GMP Charge
Private ref_FileName ' nom du fichier de référence
Private p14_FileName ' nom du fichier Projet 14 à mettre au format GMP charge
Private project_Code As String 'correspond au code du projet
Private maxValue As Long 'correspond à la valeur maximale des colonnes réalisé, RAF, Prévu, Ref pour ajuster l'echelle de l'axe primaire du graph année en cours
Private roundValue As Long 'correspond à la valeur arrondie au millier ou à la centaine
Private annee_dernier_Realise As String 'correspond à l'année du dernier réalisé
Private mois_dernier_Realise As String 'correspond au mois du dernier réalisé
Private date_dernier_Realise As Date 'correspond à la date du dernier réalisé

'Déclaration du chemin d'accès aux styles de Graph Excel (attention il est sur le réseau)
' Private Const Style_path As String = "K:\CI_SPP\Public\MODERATO\Style_Graph_Moderato.crtx"

'Déclaration du chemin d'accès aux styles de Graph Excel (attention il est sur le réseau)
Private Const Style_path As String = "K:\CI_SPP\Public\MODERATO\Graphique1.crtx"





Private Sub Imput_Macro_Suivi_des_heures()
'
'------------------------------------------------------------------------------------------------------------------------
'Macro créée par ASCO pour - Grt gaz - 2013
'-------------------------------------------------------------------------------------------------------------------------
'
' Fonction qui permet de choisir les fichiers d'entrée


' Définition des variables de cette macro
Dim Filter As String
Dim Title As String
Dim FilterIndex As Integer
Dim Repertoire As String
Dim chemin

' Récupération du répertoire du fichier actuel
Repertoire = ThisWorkbook.Path & "\"

' Création des filtres pour la fenêtre d'ouverture de fichier
Filter = "Excel Files (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm," & _
"All Files (*.*),*.*"

' Sélection du filtre par défaut
FilterIndex = 1

' Titre de la fenêtre d'ouverture de fichier
Title = "Selectionnez un fichier"

' On se place dans le répertoire définit par la variable Repertoire avant de faire l'attribution
' dans la Userform du chemin d'accès aux fichiers à utiliser pour le traitement
ChDir (Repertoire)
chemin = Application.GetOpenFilename(Filter, FilterIndex, Title)
If File_Choice = "bouton_gmp" And chemin <> False Then
frm_Choose_files.TxtB_gmp.Value = chemin
ElseIf File_Choice = "bouton_ref" And chemin <> False Then
frm_Choose_files.TxtB_ref.Value = chemin

End If
End Sub
Private Sub Macro_Process()
' Traitement principal de la macro

' On récupère les données de la Userform avant de la clôturer
gmp_Path = frm_Choose_files.TxtB_gmp.Value
ref_Path = frm_Choose_files.TxtB_ref.Value

' On récupère les noms de fichier de traitement
gmp_charge_FileName = ActiveWorkbook.Name
ref_FileName = ActiveWorkbook.Name

'' Cache le traitement + optimisations de traitement
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False


' Choix du proccessus de fonctionnement : Avec ou Sans la référence
If gmp_Path = "" Then
End
ElseIf ref_Path = "" Then
Call Process_without_ref
Else
Call Process_with_ref
End If


' Fermeture + sauvegarde du fichier de sortie après le traitement

test = Format(Date, "dd.mm.yyyy") & "_" & Format(Time, "hh") & "h" & Format(Time, "nn")

ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveAs Filename:="SUIVI_DES_HEURES_" & project_Code & "_" & test & ".xls", FileFormat:=xlExcel8

'on remet les paramètres par défaut suite à l'optimisation
Application.Calculate
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True

ActiveWorkbook.Close savechanges:=True
' Windows(gmp_charge_FileName).Close savechanges:=True, Filename:="SUIVI_DES_HEURES_" & project_Code & "_" & test & ".xlsx"

End Sub
'
' Traitement de la macro sans la référence
'
Private Sub Process_without_ref()


' On ouvre le fichier pour traitement
Workbooks.Open (gmp_Path)
' On récupère les noms de fichier de traitement
gmp_charge_FileName = ActiveWorkbook.Name
' On enlève les filtres si il y en avait avant
With Workbooks(gmp_charge_FileName).Sheets(1)
If .AutoFilterMode Then
.Cells.AutoFilter
End If
End With

' On ferme la popup de séléction
frm_Choose_files.Hide
' On s'assure de se positionner sur le premier onglet (celui de base)
Sheets(1).Activate
' on supprime les 3 premières lignes de l'entête
Rows("1:3").Select
Selection.Delete Shift:=xlUp
' on appelle la macro de mise en forme pour traitement Projet 14 en GMP Charge
Application.Run "mise_en_forme_BD"
' on appelle la macro de creation de graph par séquence
Application.Run "Creation_graph_seq_with_ref"
' on appelle la macro de creation de graph sur l'année en cours
Application.Run "Creation_graph_annee_en_cours_with_ref"
'
' WARNING : de plus on met le mode de calcul excel en manuel juste avant le décroisement
' pour optimiser le traitement des données
'
Application.Calculation = xlCalculationManual

' on appelle la macro de creation du TCD suivi des heures
Application.Run "Creation_tcd_suivi_des_heures"

End Sub
'
' Traitement de la macro avec prise en charge de la référence
'
Private Sub Process_with_ref()


' On ferme la popup de séléction
frm_Choose_files.Hide
' On ouvre le fichier GMP Charge pour traitement
Workbooks.Open (gmp_Path)
' On récupère les noms de fichier de traitement
gmp_charge_FileName = ActiveWorkbook.Name
' On enlève les filtres si il y en avait avant
With Workbooks(gmp_charge_FileName).Sheets(1)
If .AutoFilterMode Then
.Cells.AutoFilter
End If
End With
' On ouvre le fichier ref pour traitement
Workbooks.Open (ref_Path)
' On récupère les noms de fichier de traitement
ref_FileName = ActiveWorkbook.Name
' On enlève les filtres si il y en avait avant
With Workbooks(ref_FileName).Sheets(1)
If .AutoFilterMode Then
.Cells.AutoFilter
End If
End With
' Appel de la fonction de mise en forme du fichier de ref
Sheets(1).Activate

' Renvoie le nombre de ligne non vides du projet 14
nbLigne_p14 = Cells(Cells.Rows.Count, "D").End(xlUp).Row

' on se remet sur gmp charge
Windows(gmp_charge_FileName).Activate

' on supprime les 3 premières lignes de l'entête
Rows("1:3").Select
Selection.Delete Shift:=xlUp

' on met à 0 la colonne référence du GMP Charge (cas uniquement avec référence Projet 14)
nbLigne_GMP = Cells(Cells.Rows.Count, "D").End(xlUp).Row
Range("Y2").Select
ActiveCell.FormulaR1C1 = "0"
Selection.AutoFill Destination:=Range("Y2:Y" & nbLigne_GMP)
Range("A1").Select

' Appel de la fonction de copie
Call copy_data_ref_dans_GMP

'' Appel de la fonction de mise en forme du fichier GMP
' Sheets(1).Activate

' On se positionne sur le fichier gmp
Windows(gmp_charge_FileName).Activate
Call mise_en_forme_BD

' On se positionne sur le fichier gmp
Windows(gmp_charge_FileName).Activate


' Appel de la focntion de la creation du graph par séquence avec prise en charge de la réf
Call Creation_graph_seq_with_ref

' Appel de la focntion de la creation du graph sur l'année en cours avec prise en charge de la réf
Call Creation_graph_annee_en_cours_with_ref

'
' WARNING : de plus on met le mode de calcul excel en manuel juste avant le décroisement
' pour optimiser le traitement des données
'
Application.Calculation = xlCalculationManual

' on appelle la macro de creation du TCD suivi des heures
Call Creation_tcd_suivi_des_heures_projet14

'Fermeture du fichier de référence
Windows(ref_FileName).Close savechanges:=False


End Sub


Sub mise_en_forme_BD()

'
' mise_en_forme_BD Macro
' Mise en forme du fichier GMP Charge pour création graphique croisé dynamique
'

'Agencement des colonnes
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

' Renvoie le nombre de ligne non vides
ligneFin = Cells(Cells.Rows.Count, "D").End(xlUp).Row

' On supprime la disponibilité globale
Range("Z:Z").Delete Shift:=xlToLeft

' on supprime le prévu probabilisé
Range("X:X").Delete Shift:=xlToLeft

' on force les ressources de la colonne N en Majuscule
Range("Y2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-12]=""NON"",RC[-11],UPPER(RC[-11]))"
Selection.AutoFill Destination:=Range("Y2:Y" & ligneFin), Type:=xlFillDefault
Calculate
Range("Y2:Y" & ligneFin).Copy
Range("N2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("Y:Y").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

' on créé la colonne date période
Columns("U:U").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("U1").Select
ActiveCell.FormulaR1C1 = "Date Période"
Range("U2").Select

' Pour le graphique année en cours on applique la formule de paramètrages
' et format personnalisé sur la date Période
ActiveCell.FormulaR1C1 = _
"=IF(YEAR(RC[-1])<YEAR(TODAY()),DATE(""2013"",""01"",""01""),IF(YEAR(RC[-1])>YEAR(TODAY()),DATE(YEAR(RC[-1]),""01"",""01""),RC[-1]))"
Selection.AutoFill Destination:=Range("U2:U" & ligneFin), Type:=xlFillDefault
Calculate
Range("U2:U" & ligneFin).NumberFormat = "[<41614]""avant janv.-14"";[>42004]yyyy;mmm.-yy"
Range("U2:U" & ligneFin).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Columns("V:V").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("V1").FormulaR1C1 = "Date Graph"
Range("V2").FormulaR1C1 = "=RC[-2]"
Range("V2").Select
Range("V2").NumberFormat = "[$-40C]mmm-yy;@"
Selection.AutoFill Destination:=Range("V2:V" & ligneFin)
Calculate
Range("V2:V" & ligneFin).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Call ClearClipboard
project_Code = Range("C2").Value

'On créer le DPT du SF d'Affectation à droite des colonnes de données et on supprime ces colonnes de travail
Range("AA2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-10],3)"
Selection.AutoFill Destination:=Range("AA2:AA" & ligneFin)
Calculate
Range("AA2:AA" & ligneFin).Select
Selection.Copy
Range("P2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'On créer le DPT du SF Principal à droite des colonnes de données et on supprime ces colonnes de travail
Range("AB2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-9],3)"
Selection.AutoFill Destination:=Range("AB2:AB" & ligneFin)
Calculate
Range("AB2:AB" & ligneFin).Select
Selection.Copy
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' On supprime la colonne Type de séquence
Range("J:J").Delete Shift:=xlToLeft

' suppression des colonnes de traitement
Columns("Z:AB").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

End Sub

Sub copy_data_ref_dans_GMP()
' Fonction qui permet de copier les données de la référence (P14) à la suite du fichier GMP charge
'(pour ensuite procéder au bon traitement de la macro avec prise en compte de la réf)

Windows(ref_FileName).Activate
Sheets(1).Activate

' Renvoie le nombre de ligne non vides
nbLigne_p14 = Cells(Cells.Rows.Count, "D").End(xlUp).Row
' Copie des data de réf
Range("A1", "Y" & nbLigne_p14).Select
Selection.Copy

' Colle les valeurs dans l'autre fichier (gmp charge)
Windows(gmp_charge_FileName).Activate
Sheets(1).Activate
Range("A" & nbLigne_GMP + 1).Select
ActiveSheet.Paste

' on uniformise le code du projet sur l'ensemble des lignes (gmp charge + référence)
nbLigne_total = Cells(Cells.Rows.Count, "D").End(xlUp).Row
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D" & nbLigne_total), Type:=xlFillCopy
Calculate
Range("A1").Select
' vide le presse papier après la copie
Windows(ref_FileName).Activate
Call ClearClipboard

End Sub

Sub Creation_graph_seq_with_ref()
'
' Creation_graph_seq Macro
' Cette macro créér un graphique croisé dynamique par séquence à partir du fichier de base GMP charge

'Active la fenetre GMP_charge modifié
Windows(gmp_charge_FileName).Activate
' Renvoie le nombre de ligne non vides
ligneFin = Cells(Cells.Rows.Count, "C").End(xlUp).Row

Range("A1").Select
Sheets.Add

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Rapport 1! R1C1:R" & ligneFin & "C25", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="Feuil1!R1C1", TableName:="Tableau croisé dynamique3", _
DefaultVersion:=xlPivotTableVersion12

Sheets("Feuil1").Select
Cells(1, 1).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("'Feuil1'!$A$1:$C$18")
ActiveChart.ChartType = xlColumnClustered

'ajout de réalisé
ActiveSheet.PivotTables("Tableau croisé dynamique3").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique3").PivotFields("Réalisé"), _
"Somme de Réalisé", xlSum
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"Somme de Réalisé")
.Caption = "Réalisé (h)"
.NumberFormat = "0"
End With
'ajout de la référence
ActiveSheet.PivotTables("Tableau croisé dynamique3").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique3").PivotFields("Référence"), "Somme de Référence" _
, xlSum
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"Somme de Référence")
.Caption = "Référence (h)"
.NumberFormat = "0"
End With

'ajout du RAF
ActiveSheet.PivotTables("Tableau croisé dynamique3").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique3").PivotFields("RAF"), "Somme de RAF" _
, xlSum
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"Somme de RAF")
.Caption = "RAF (h)"
.NumberFormat = "0"
End With
'Ajout des filtres pour le TCD et Graphique
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"SF d'affectation")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"Code du Projet")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"Séquence")
.Orientation = xlPageField
.Position = 1
End With
'etiquette de ligne
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields("Date Graph")
.Orientation = xlRowField
.Position = 1
End With

'Renommer la feuille créée automatiquement à la création du TCD/GDC
Sheets("Feuil1").Select
Sheets("Feuil1").Name = name_TCD_seq
Sheets(name_TCD_seq).Move After:=Sheets(2)

'Change le format du tableau de données en mois-année (ex "jan-13")
Range("A7:A34").Select
Selection.NumberFormat = "[$-40C]mmm-yy;@"

'Ajoute les cumuls de réalisé + prévu + référence

ActiveSheet.PivotTables("Tableau croisé dynamique3").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique3").PivotFields("Réalisé"), _
"Somme de Réalisé2", xlSum
ActiveSheet.PivotTables("Tableau croisé dynamique3").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique3").PivotFields("Référence"), _
"Somme de Référence2", xlSum
ActiveSheet.PivotTables("Tableau croisé dynamique3").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique3").PivotFields("Prévu"), _
"Somme de Prévu", xlSum
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"Somme de Réalisé2")
.Caption = "Cumul de Réalisé (h)"
.Calculation = xlRunningTotal
.BaseField = "Date Graph"
.NumberFormat = "0"
End With
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"Somme de Référence2")
.Caption = "Cumul de Référence (h)"
.Calculation = xlRunningTotal
.BaseField = "Date Graph"
.NumberFormat = "0"
End With
With ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotFields( _
"Somme de Prévu")
.Caption = "Cumul de Prévu (h)"
.Calculation = xlRunningTotal
.BaseField = "Date Graph"
.NumberFormat = "0"
End With

'Applique le format désiré
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.ApplyChartTemplate ( _
Style_path _
)
'Applique les titres des axes désirés
ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Nombre d'heures mensuelles"
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.SetElement (msoElementSecondaryValueAxisTitleRotated)
ActiveChart.Axes(xlValue, xlSecondary).AxisTitle.Text = "Cumuls nombre d'heures"
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.ChartArea.Select


'Déplace le graph dans une nouvelle feuille et ferme fenêtres inutiles
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=name_GCD_seq
ActiveWorkbook.ShowPivotChartActiveFields = False
ActiveWorkbook.ShowPivotTableFieldList = False
Sheets(name_GCD_seq).Select
With ActiveWorkbook.Sheets(name_GCD_seq).Tab
.Color = 255
.TintAndShade = 0
End With
Sheets(name_GCD_seq).Move After:=Sheets(3)
Sheets(name_TCD_seq).Visible = 0

End Sub


Sub Creation_graph_annee_en_cours_with_ref()
'
' Creation_graph_annee_en_cours
' Cette macro créér un graphique croisé dynamique avec zoom sur l'année en cours
' à partir du fichier de base GMP charge


Sheets("Rapport 1").Select
' Renvoie le nombre de ligne non vides
ligneFin = Cells(Cells.Rows.Count, "C").End(xlUp).Row

Range("A1").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Rapport 1! R1C1:R" & ligneFin & "C25", Version:=xlPivotTableVersion12). _
CreatePivotTable TableDestination:="Feuil2!R1C1", TableName:= _
"Tableau croisé dynamique5", DefaultVersion:=xlPivotTableVersion12

Sheets("Feuil2").Select
Cells(1, 1).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("'Feuil2'!$A$1:$C$18")
ActiveChart.ChartType = xlColumnClustered
' ajout du réalisé (histogramme)
ActiveSheet.PivotTables("Tableau croisé dynamique5").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique5").PivotFields("Réalisé"), _
"Somme de Réalisé", xlSum
With ActiveSheet.PivotTables("Tableau croisé dynamique5").PivotFields( _
"Somme de Réalisé")
.Caption = "Réalisé (h)"
.NumberFormat = "0"
End With
'ajout de la référence (histogramme)
ActiveSheet.PivotTables("Tableau croisé dynamique5").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique5").PivotFields("Référence"), "Somme de Référence" _
, xlSum
With ActiveSheet.PivotTables("Tableau croisé dynamique5").PivotFields( _
"Somme de Référence")
.Caption = "Référence (h)"
.NumberFormat = "0"
End With
' ajout du RAF (histogramme)
ActiveSheet.PivotTables("Tableau croisé dynamique5").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique5").PivotFields("RAF"), "Somme de RAF" _
, xlSum
With ActiveSheet.PivotTables("Tableau croisé dynamique5").PivotFields( _
"Somme de RAF")
.Caption = "RAF (h)"
.NumberFormat = "0"
End With
' étiquette de ligne
With ActiveSheet.PivotTables("Tableau croisé dynamique5").PivotFields("Date période")
.Orientation = xlRowField
.Position = 1
End With

'Renommer la feuille créée automatiquement à la création du GCD + deplacement
Sheets("Feuil2").Select
' Renvoie la valeur max des colonnes B à D (attention données non dynamique)
maxValue = Application.WorksheetFunction.Max(Range("B4:D15"))
' Arrondi l'echelle à la centaine ou au milliers
If (maxValue < 1000) Then
roundValue = Application.WorksheetFunction.RoundUp(maxValue, -2)
Else
roundValue = Application.WorksheetFunction.RoundUp(maxValue, -3)
End If

Sheets("Feuil2").Name = name_TCD_annee_en_cours
Sheets(name_TCD_annee_en_cours).Move After:=Sheets(4)

'Change le format du tableau de données en mois-année (ex "jan-13")
'Range("A7:A34").Select
'Selection.NumberFormat = "[$-40C]mmm-yy;@"

'Ajoute les cumuls de référence + réalisé + prévu

ActiveSheet.PivotTables("Tableau croisé dynamique5").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique5").PivotFields("Réalisé"), _
"Somme de Réalisé2", xlSum
ActiveSheet.PivotTables("Tableau croisé dynamique5").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique5").PivotFields("Référence"), _
"Somme de Référence2", xlSum
ActiveSheet.PivotTables("Tableau croisé dynamique5").AddDataField ActiveSheet. _
PivotTables("Tableau croisé dynamique5").PivotFields("Prévu"), _
"Somme de Prévu", xlSum
With ActiveSheet.PivotTables("Tableau croisé dynamique5").PivotFields( _
"Somme de Réalisé2")
.Caption = "Cumul de Réalisé (h)"
.Calculation = xlRunningTotal
.BaseField = "Date période"
.NumberFormat = "0"
End With
With ActiveSheet.PivotTables("Tableau croisé dynamique5").PivotFields( _
"Somme de Référence2")
.Caption = "Cumul de Référence (h)"
.Calculation = xlRunningTotal
.BaseField = "Date période"
.NumberFormat = "0"
End With
With ActiveSheet.PivotTables("Tableau croisé dynamique5").PivotFields( _
"Somme de Prévu")
.Caption = "Cumul de Prévu (h)"
.Calculation = xlRunningTotal
.BaseField = "Date période"
.NumberFormat = "0"
End With
'Applique le format désiré
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.ApplyChartTemplate ( _
Style_path _
)
'Applique les titres des axes désirés
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Nombre d'heures mensuelles"
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.SetElement (msoElementSecondaryValueAxisTitleRotated)
ActiveChart.Axes(xlValue, xlSecondary).AxisTitle.Text = "Cumuls nombre d'heures"
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.ChartArea.Select

testcol = ActiveChart.SeriesCollection.Count
testpoint = ActiveChart.SeriesCollection(1).Points.Count
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.SeriesCollection(4).Points(testpoint).ApplyDataLabels
ActiveChart.SeriesCollection(4).DataLabels.Select
Selection.Font.Bold = True
Selection.Font.Size = 8
Selection.Font.Color = RGB(0, 176, 80)

ActiveChart.SeriesCollection(5).Points(testpoint).ApplyDataLabels
ActiveChart.SeriesCollection(5).DataLabels.Select
Selection.Font.Bold = True
Selection.Font.Size = 8
Selection.Font.Color = RGB(153, 0, 51)


ActiveChart.SeriesCollection(6).Points(testpoint).ApplyDataLabels
ActiveChart.SeriesCollection(6).DataLabels.Select
Selection.Font.Bold = True
Selection.Font.Size = 8
Selection.Font.Color = RGB(0, 176, 240)


Periode = 12
For i = 1 To ActiveChart.SeriesCollection(1).Points.Count
If (i = 1) Or (i > Periode + 1) Then

For k = 1 To ActiveChart.SeriesCollection.Count
If InStr(1, ActiveChart.SeriesCollection.Item(k).Name, _
"Cumul") = 0 Then
With ActiveChart.SeriesCollection(k).Points(i)
.Interior.Pattern = xlNone
.Border.LineStyle = xlLineStyleNone
End With
End If
Next k
End If
Next i
ActiveChart.Axes(xlValue).MaximumScale = roundValue
ActiveChart.Axes(xlValue).MinimumScale = 0

'Déplace le graph dans une nouvelle feuille et ferme fenêtres inutiles
ActiveSheet.ChartObjects("Graphique 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=name_GCD_annee_en_cours

ActiveWorkbook.ShowPivotChartActiveFields = False
ActiveWorkbook.ShowPivotTableFieldList = False

Sheets(name_GCD_annee_en_cours).Select
With ActiveWorkbook.Sheets(name_GCD_annee_en_cours).Tab
.Color = 255
.TintAndShade = 0
End With
Sheets(name_TCD_annee_en_cours).Visible = 0
Sheets(name_GCD_annee_en_cours).Move After:=Sheets(5)
End Sub

'
' Création du TCD pour le suivi des heures pour le traitement sans projet 14
'

Sub Creation_tcd_suivi_des_heures()
Dim lig&, lig1&, col%, lig2&
Dim Tblo()
Dim a As Integer, b As Integer

' on duplique le rapport 1 en Base_TCD pour traitement
Sheets("Rapport 1").Select
Sheets("Rapport 1").Copy After:=Sheets(5)
Sheets("Rapport 1 (2)").Name = "Base_TCD"

' on insère la colonne Type
Columns("V:V").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove


' on transpose les données
For lig = [A65536].End(xlUp).Row To 2 Step -1
lig1 = lig + 1
lig2 = lig1 + 1
lig3 = lig2 + 1
col = 25
col1 = 24
col2 = 26
While Cells(lig, col) <> ""
Rows(lig1).Insert
Cells(lig1, 23).Resize(, 1) = Cells(lig, col1).Resize(, 1).Value
Cells(lig1, 1).Resize(, 21) = Cells(lig, 1).Resize(, 21).Value

Rows(lig2).Insert
Cells(lig2, 23).Resize(, 1) = Cells(lig, col).Resize(, 2).Value
Cells(lig2, 1).Resize(, 21) = Cells(lig, 1).Resize(, 21).Value

Rows(lig3).Insert
Cells(lig3, 23).Resize(, 1) = Cells(lig, col2).Resize(, 3).Value
Cells(lig3, 1).Resize(, 21) = Cells(lig, 1).Resize(, 21).Value

Cells(lig3, 22).Resize(, 1) = "Référence"
Cells(lig2, 22).Resize(, 1) = "Prévu"
Cells(lig1, 22).Resize(, 1) = "RAF"
Cells(lig, 22).Resize(, 1) = "Réalisé"

lig1 = lig1 + 1
col = col + 2
Wend
Next

'' A été ôté car bug au niveau de la création du TCD ( Affichage dans "Type" du RAF)

' on supprime les lignes de base TCD qui ont pour valeur 0
' (condition sur colonne 23: si nb heure = 0 alors on suppr la ligne)
For lig = [A65536].End(xlUp).Row To 2 Step -1
If Cells(lig, 23).Value = 0 Then
Rows(lig).Delete
End If
Next

' Renvoie le nombre de ligne non vides
ligneFin = Cells(Cells.Rows.Count, "C").End(xlUp).Row


'annee_dernier_Realise_max = "2012"
'mois_dernier_Realise_max "01"
'For lig = [A65536].End(xlUp).Row To 2 Step -1
' If Cells(lig, 13).Value = "OUI" Then
' If Cells(lig, 22).Value = "Réalisé" Then
' annee_dernier_Realise = Format(Cells(lig, 19).Value, "yyyy")
' mois_dernier_Realise = Format(Cells(lig, 19).Value, "mm")
'
' If mois_dernier_Realise > mois_dernier_Realise_max Then
' mois_dernier_Realise_max = mois_dernier_Realise
' End If
'
' If annee_dernier_Realise > annee_dernier_Realise_max Then
' annee_dernier_Realise_max = annee_dernier_Realise
' End If
'
' End If
' End If
'Next

' on récupère la date du dernier réalisé
Range("X2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-11]=""OUI"",RC[-2]=""Réalisé""),RC[-5],DATE(""2012"",""01"",""01""))"

Selection.AutoFill Destination:=Range("X2:X" & ligneFin), Type:=xlFillDefault
Calculate
Range("Y2").Select
ActiveCell.FormulaR1C1 = "=MAX(C[-1])"
Range("Z2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[-1])"
Range("AA2").Select
ActiveCell.FormulaR1C1 = "=MONTH(RC[-2])"

' on récupere les dates, mois et année dans des variables internes
date_dernier_Realise = Range("Y2").Value
annee_dernier_Realise = Range("Z2").Value
mois_dernier_Realise = Range("AA2").Value



' on supprime les colonne X à AA
Columns("X:AA").Delete Shift:=xlToLeft
' on renomme la colonne V : Type
Range("V1").Select
ActiveCell.FormulaR1C1 = "Type"
' on renomme la colonne W : Heures
Range("W1").Select
ActiveCell.FormulaR1C1 = "Heures"


' Création du TCD
Range("A1").Select
Sheets.Add
Sheets("Feuil4").Name = name_TCD
Sheets(name_TCD).Move After:=Sheets(6)
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Base_TCD!R1C1:R" & ligneFin & "C23", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:=name_TCD & "!R3C1", TableName:=name_TCD, _
DefaultVersion:=xlPivotTableVersion12
Sheets(name_TCD).Select
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"Code du Projet")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"Ressource?")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"Date Graph")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"Séquence")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields("CI (Dpt/Ag) du SF d'affectation")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"SF d'affectation")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields("Type")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields("Type")
.PivotItems("RAF").Visible = False
.PivotItems("Réalisé").Visible = False
.PivotItems("Prévu").Visible = True
.PivotItems("Référence").Visible = True
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"Savoir-faire / Ressource")
.Orientation = xlRowField
.Position = 5
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"Statut")
.Orientation = xlRowField
.Position = 6
End With
ActiveSheet.PivotTables(name_TCD).AddDataField ActiveSheet. _
PivotTables(name_TCD).PivotFields("Heures"), _
"Somme de Heures", xlSum
' on arrondi la somme des charges
With ActiveSheet.PivotTables("TCD_Suivi_heures").PivotFields("Somme de Heures")
.NumberFormat = "0"
End With
ActiveSheet.PivotTables(name_TCD).RowAxisLayout xlTabularRow
Range("D6").Select
ActiveSheet.PivotTables(name_TCD).PivotFields("Type"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Range("C6").Select
ActiveSheet.PivotTables(name_TCD).PivotFields("SF d'affectation" _
).Subtotals = Array(False, False, False, False, False, False, False, False, False, False _
, False, False)
Range("B6").Select
ActiveSheet.PivotTables(name_TCD).PivotFields("CI (Dpt/Ag) du SF d'affectation"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Range("A6").Select
ActiveSheet.PivotTables(name_TCD).PivotFields("Séquence"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)

Range("E6").Select
ActiveSheet.PivotTables(name_TCD).PivotFields("Savoir-faire / ressource"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)

' on applique une police de caractère dans le TCD
ActiveSheet.PivotTables(name_TCD).PivotSelect "", _
xlDataAndLabel, True
With Selection.Font
.Name = "Calibri"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With

' on groupe le champs Date Graph par MOIS + ANNEE par défaut
Range("G4").Select
Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
False, True, False, True)

' on applique la mise en forme conditionnelle dans le TCD

ActiveSheet.PivotTables("TCD_Suivi_heures").PivotSelect "Référence", _
xlDataAndLabel, True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With

'TEST
Set Plage = Range("G2", "BB2")
For Each Cell In Plage
For i = 1 To 11 Step 1
Cells(1, 10).Value = i
Next
Next

' mise en exergue de l'année

Rows("5:5").Select
Selection.FormatConditions.Add Type:=xlTextString, String:=annee_dernier_Realise, _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

Range("A1").Select

'' mise en forme gabriel (il semblerait que cela fonctionne uniquement avec un format .xlsx)
' With Selection
' .FormatConditions.Add Type:=xlExpression, Formula1:= _
' "=ET(INDEX($A$1:$XX100000;LIGNE(A6);EQUIV(" & _
' VBA.Chr(34) & "Type" & VBA.Chr(34) & ";$5:$5;0))<>" & _
' VBA.Chr(34) & "Référence" & VBA.Chr(34) & _
' ";INDEX($A$1:$XX100000;LIGNE(A6);EQUIV(" & VBA.Chr(34) & _
' "Type" & VBA.Chr(34) & ";$5:$5;0))<>" & VBA.Chr(34) & VBA.Chr(34) & ")"
' .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
' With .FormatConditions(1)
' .StopIfTrue = False
' With .Interior
' .PatternColorIndex = xlAutomatic
' .ThemeColor = xlThemeColorAccent1
' .TintAndShade = 0.799981688894314
' End With
' End With
' End With
' Cells.Select
' With Selection
' .FormatConditions.Add Type:=xlExpression, Formula1:= _
' "=ET(INDEX($A$1:$XX100000;LIGNE(A1);EQUIV(" & _
' VBA.Chr(34) & "Type" & VBA.Chr(34) & ";$5:$5;0))<>" & _
' VBA.Chr(34) & "Référence" & VBA.Chr(34) & _
' ";INDEX($A$1:$XX100000;LIGNE(A1);EQUIV(" & VBA.Chr(34) & _
' "Type" & VBA.Chr(34) & ";$5:$5;0))<>" & VBA.Chr(34) & VBA.Chr(34) & ")"
' .FormatConditions(Cells.FormatConditions.Count).SetFirstPriority
' With .FormatConditions(1).Interior
' .PatternColorIndex = xlAutomatic
' .ThemeColor = xlThemeColorAccent1
' .TintAndShade = 0.799981688894314
' End With
' .FormatConditions(1).StopIfTrue = False
' End With

' on colorie l'onglet TCD_Suivi_Heures
With ActiveSheet.Tab
.Color = 255
.TintAndShade = 0
End With
' on cache les fenetres liste des champs et filtres
ActiveWorkbook.ShowPivotChartActiveFields = False
ActiveWorkbook.ShowPivotTableFieldList = False

' on cache les feuilles de traitement
Sheets("Base_TCD").Visible = 0
Sheets(1).Visible = 0

End Sub
'
' Création du TCD pour le suivi des heures pour le traitement avec projet 14
'
Sub Creation_tcd_suivi_des_heures_projet14()

Dim lig&, lig1&, col%, lig2&
Dim Tblo()
Dim a As Integer, b As Integer

' on duplique le rapport 1 en Base_TCD pour traitement
Sheets("Rapport 1").Select
Sheets("Rapport 1").Copy After:=Sheets(5)
Sheets("Rapport 1 (2)").Name = "Base_TCD"

' on supprime les lignes du projet 14
Rows(nbLigne_GMP + 1 & ":" & nbLigne_total).Select
Selection.Delete Shift:=xlUp
Range("A1").Select


' on insère la colonne Type
Columns("V:V").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

' on transpose les données
For lig = [A65536].End(xlUp).Row To 2 Step -1
lig1 = lig + 1
lig2 = lig1 + 1
lig3 = lig2 + 1
col = 25
col1 = 24
col2 = 26
While Cells(lig, col) <> ""
Rows(lig1).Insert
Cells(lig1, 23).Resize(, 1) = Cells(lig, col1).Resize(, 1).Value
Cells(lig1, 1).Resize(, 21) = Cells(lig, 1).Resize(, 21).Value

Rows(lig2).Insert
Cells(lig2, 23).Resize(, 1) = Cells(lig, col).Resize(, 2).Value
Cells(lig2, 1).Resize(, 21) = Cells(lig, 1).Resize(, 21).Value

Rows(lig3).Insert
Cells(lig3, 23).Resize(, 1) = Cells(lig, col2).Resize(, 3).Value
Cells(lig3, 1).Resize(, 21) = Cells(lig, 1).Resize(, 21).Value

Cells(lig3, 22).Resize(, 1) = "Référence"
Cells(lig2, 22).Resize(, 1) = "Prévu"
Cells(lig1, 22).Resize(, 1) = "RAF"
Cells(lig, 22).Resize(, 1) = "Réalisé"

lig1 = lig1 + 1
col = col + 2
Wend
Next

' on supprime les colonne X à Z
Columns("X:Z").Delete Shift:=xlToLeft

' on renomme la colonne V : Type
Range("V1").Select
ActiveCell.FormulaR1C1 = "Type"

' on renomme la colonne W : Heures
Range("W1").Select
ActiveCell.FormulaR1C1 = "Heures"



' on récupere les lignes du projets 14 à copier en dessous du GMP décroisé
Sheets("Rapport 1").Select
' on supprime les colonne W à X
Columns("W:X").Delete Shift:=xlToLeft

Range("V" & nbLigne_GMP + 1).Select
ActiveCell.FormulaR1C1 = "Référence"
Selection.AutoFill Destination:=Range("V" & nbLigne_GMP + 1 & ":" & "V" & nbLigne_total)
' on copie les lignes projet 14 à mettre en dessous du GMP transposé
Range("A" & nbLigne_GMP + 1 & ":" & "W" & nbLigne_total).Copy
Sheets("Base_TCD").Select
' Renvoie le nombre de ligne non vides
ligneFin = Cells(Cells.Rows.Count, "C").End(xlUp).Row
Range("A" & ligneFin + 1).Select
ActiveSheet.Paste

' Renvoie le nombre de ligne non vides
ligneFin = Cells(Cells.Rows.Count, "C").End(xlUp).Row

' Création du TCD
Range("A1").Select
Sheets.Add
Sheets("Feuil4").Name = name_TCD
Sheets(name_TCD).Move After:=Sheets(6)
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Base_TCD!R1C1:R" & ligneFin & "C23", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:=name_TCD & "!R3C1", TableName:=name_TCD, _
DefaultVersion:=xlPivotTableVersion12
Sheets(name_TCD).Select
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"Code du Projet")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"Ressource?")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"Date Graph")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"Séquence")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields("CI (Dpt/Ag) du SF d'affectation")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"SF d'affectation")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields("Type")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields("Type")
.PivotItems("RAF").Visible = False
.PivotItems("Réalisé").Visible = False
.PivotItems("Prévu").Visible = True
.PivotItems("Référence").Visible = True
End With
With ActiveSheet.PivotTables(name_TCD).PivotFields( _
"Savoir-faire / Ressource")
.Orientation = xlRowField
.Position = 5
End With
ActiveSheet.PivotTables(name_TCD).AddDataField ActiveSheet. _
PivotTables(name_TCD).PivotFields("Heures"), _
"Somme de Heures", xlSum
' on arrondi la somme des charges
With ActiveSheet.PivotTables("TCD_Suivi_heures").PivotFields("Somme de Heures")
.NumberFormat = "0"
End With
ActiveSheet.PivotTables(name_TCD).RowAxisLayout xlTabularRow
Range("D6").Select
ActiveSheet.PivotTables(name_TCD).PivotFields("Type"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Range("C9").Select
ActiveSheet.PivotTables(name_TCD).PivotFields("SF d'affectation" _
).Subtotals = Array(False, False, False, False, False, False, False, False, False, False _
, False, False)
Range("B9").Select
ActiveSheet.PivotTables(name_TCD).PivotFields("CI (Dpt/Ag) du SF d'affectation"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Range("A10").Select
ActiveSheet.PivotTables(name_TCD).PivotFields("Séquence"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
' on applique une police de caractère dans le TCD
ActiveSheet.PivotTables(name_TCD).PivotSelect "", _
xlDataAndLabel, True
With Selection.Font
.Name = "Calibri"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With

' on groupe le champs Date Graph par MOIS + ANNEE par défaut
Range("F4").Select
Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
False, True, False, True)

' on applique la mise en forme conditionnelle dans le TCD

ActiveSheet.PivotTables("TCD_Suivi_heures").PivotSelect "Référence", _
xlDataAndLabel, True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With

' mise en exergue de l'année

Rows("5:5").Select
Selection.FormatConditions.Add Type:=xlTextString, String:=annee_dernier_Realise, _
TextOperator:=xlContains
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

Range("A1").Select

'' on applique la mise en forme conditionnelle dans le TCD
'
' With Selection
' .FormatConditions.Add Type:=xlExpression, Formula1:= _
' "=ET(INDEX($A$1:$XX100000;LIGNE(A6);EQUIV(" & _
' Chr(34) & "Type" & Chr(34) & ";$5:$5;0))<>" & _
' Chr(34) & "Référence" & Chr(34) & _
' ";INDEX($A$1:$XX100000;LIGNE(A6);EQUIV(" & Chr(34) & _
' "Type" & Chr(34) & ";$5:$5;0))<>" & Chr(34) & Chr(34) & ")"
' .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
' With .FormatConditions(1)
' .StopIfTrue = False
' With .Interior
' .PatternColorIndex = xlAutomatic
' .ThemeColor = xlThemeColorAccent1
' .TintAndShade = 0.799981688894314
' End With
' End With
' End With
' Cells.Select
' With Selection
' .FormatConditions.Add Type:=xlExpression, Formula1:= _
' "=ET(INDEX($A$1:$XX100000;LIGNE(A1);EQUIV(" & _
' Chr(34) & "Type" & Chr(34) & ";$5:$5;0))<>" & _
' Chr(34) & "Référence" & Chr(34) & _
' ";INDEX($A$1:$XX100000;LIGNE(A1);EQUIV(" & Chr(34) & _
' "Type" & Chr(34) & ";$5:$5;0))<>" & Chr(34) & Chr(34) & ")"
' .FormatConditions(Cells.FormatConditions.Count).SetFirstPriority
' With .FormatConditions(1).Interior
' .PatternColorIndex = xlAutomatic
' .ThemeColor = xlThemeColorAccent1
' .TintAndShade = 0.799981688894314
' End With
' .FormatConditions(1).StopIfTrue = False
' End With

With ActiveSheet.Tab
.Color = 255
.TintAndShade = 0
End With

' on cache les fenetres liste des champs et filtres
ActiveWorkbook.ShowPivotChartActiveFields = False
ActiveWorkbook.ShowPivotTableFieldList = False

' on cache les feuilles de traitement
Sheets("Base_TCD").Visible = 0
Sheets(1).Visible = 0


End Sub

Sub ClearClipboard()
Dim oDataObject As DataObject

Set oDataObject = New DataObject
oDataObject.SetText ""
oDataObject.PutInClipboard

Set oDataObject = Nothing
End Sub
Sub Close_no_save()
'Close the workbook without saving it
ThisWorkbook.Close savechanges:=False
End Sub
 

Staple1600

XLDnaute Barbatruc
Re : Booster une macro

Bonsoir à tous

Job75 (Re, ;))
Si NektarMinuit <> de ASCO alors oui Nectar peut être novice
Code vba:
Private Sub Imput_Macro_Suivi_des_heures()
'----------------------------------------
'Macro créée par ASCO pour - Grt gaz - 2013
'-----------------------------------------

Ce qui est quasi sûr, par contre c'est que NektarMinuit est novice en balises BBCODE.
(mais cela normal pour un nouveau membre d'XLD ;))

Quoique sachant forcément lire, NecktarMinuit aurait pu néanmoins joindre un fichier exemple ...:rolleyes:

Mais ce faisant , il n'aurait pas battu le record de 1303 lignes ;)
 
Dernière édition:

Cousinhub

XLDnaute Barbatruc
Re : Booster une macro

Bonsoir tout le monde,

Hi Job75 ;)
Hi J-M (Merci pour le lien...) ;)
Bonsoir, Pyfux

Comment ça, "ASCO" ne sait pas ce qu'il fait....

La preuve :

Code:
.......
Set Plage = Range("G2", "BB2")
For Each Cell In Plage
    For i = 1 To 11 Step 1
    Cells(1, 10).Value = i
    Next
Next
......

Il fallait au moins toutes ces lignes de code, pour dire à la cellule "J1" de prendre la valeur de "11"

Ah les boucles....

NDLR : Ces lignes ont été tirées au hasard, dans les 1303 lignes....:cool:

Bon W-E
 

Staple1600

XLDnaute Barbatruc
Re : Booster une macro

Bonjour à tous

Comme samedi c'est jour de ménage dans mon logis et donc pour rester dans le thème
Tu peux nettoyer ton code VBA en évitant autant que faire se peut les Select et Activate.
Exemple: Ceci
Code:
Range("Y2").Select
ActiveCell.FormulaR1C1 = "=MAX(C[-1])"
Range("Z2").Select[
ActiveCell.FormulaR1C1 = "=YEAR(RC[-1])"
Range("AA2").Select
ActiveCell.FormulaR1C1 = "=MONTH(RC[-2])"

peut s'écrire plus simplement
Code:
Range("Y2").FormulaR1C1 = "=MAX(C[-1])"
Range("Z2").FormulaR1C1 = "=YEAR(RC[-1])"
Range("AA2").FormulaR1C1 = "=MONTH(RC[-2])"
Pareil ici, je te laisse donc faire un peu de ménage "vbaistique"
Code:
' on renomme la colonne V : Type
Range("V1").Select[/FONT][/COLOR]
ActiveCell.FormulaR1C1 = "Type"
' on renomme la colonne W : Heures
Range("W1").Select[/FONT][/COLOR]
ActiveCell.FormulaR1C1 = "Heures"
PS: Pour formater ton code VBA, tu peux utiliser la la balise
Code:
[/B]
 [B][noparse][CODE][/noparse][/B][COLOR=#0000ff][SIZE=2]Ici le code VBA[/SIZE][/COLOR][B][noparse]
[/noparse]
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof