Code VBA (lenteur d'exécution)
Bonsoir,
J'ai réalisé un planning de congés du personnel avec une assistance appuyée par l'un des modérateurs de ce site.
A ceux qui maîtrisent le langage de programmation, vous serait-il possible d'améliorer les lignes ci-après en les lisant simplement. Je m'explique, le fichier auquel elles sont associées, recalcule les données présentes dans la feuille (avec une lenteur modérée) à chaque basculement entre les onglets.
Il me semble que certaines lignes de commande peuvent être écourtées ou simplifiées, pour rendre plus fluide, la navigation d'une feuille à l'autre.
Ayant finalisé mon fichier, si vous en aviez besoin, je pourrais vous le transmettre en message privé.
En vous remerciant pour votre aide.
Option Explicit
Sub Macro1()
'
' Macro1 Macro
'
'
Cells.FormatConditions.Delete
Range("B4:AF12").Select
Range("B6").Activate
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=JOURSEM(B$3;2)>5"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
ExecuteExcel4Macro "(2,1,""Standard"")"
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
End With
Selection.FormatConditions(1).StopIfTrue = True
Range("B3:AF3").Select
Range("B6").Activate
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=JOURSEM(B$3;2)>5"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599963377788629
End With
Selection.FormatConditions(1).StopIfTrue = True
Range("B3:AF3").Select
Range("B6").Activate
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=AUJOURDHUI()"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
Range("B4:AF12").Select
Range("B6").Activate
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""P"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
ExecuteExcel4Macro "(2,1,""P"")"
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("B4:AF12").Select
Range("B6").Activate
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""RTT"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
ExecuteExcel4Macro "(2,1,""\RTT"")"
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("B4:AF12").Select
Range("B6").Activate
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""R"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
ExecuteExcel4Macro "(2,1,""\R"")"
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
Range("B14:AF14").Select
Range("B6").Activate
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=JOURSEM(B$3;2)>5"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
ExecuteExcel4Macro "(2,1,""Standard"")"
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
End With
Selection.FormatConditions(1).StopIfTrue = True
Range("B14:AF14").Select
Range("B6").Activate
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""P"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
ExecuteExcel4Macro "(2,1,""P"")"
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("B14:AF14").Select
Range("B6").Activate
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""RTT"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
ExecuteExcel4Macro "(2,1,""\RTT"")"
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("B14:AF14").Select
Range("B6").Activate
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""R"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
ExecuteExcel4Macro "(2,1,""\R"")"
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("B14:AF14").Select
Range("B6").Activate
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""F"""
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Range("B15:AF15").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B26") = 1 / 30 / 2015
Sheets("Vacances").Select
Range("B7").Select
Sheets("Vacances").Select
Range("B5").Select
ActiveCell.FormulaR1C1 = "1/30/2015"
Range("E13").Select
Sheets("Calendrier").Select
Range("H23").Select
Sheets("Vacances").Select
Range("B5").Select
ActiveCell.FormulaR1C1 = "2/2/2015"
Range("C9").Select
Sheets("Vacances").Select
Range("A5").Select
ActiveCell.FormulaR1C1 = "2/20/2015"
Range("B5").Select
ActiveCell.FormulaR1C1 = "3/2/2015"
Sheets("Calendrier").Select
Range("E1").Select
Sheets("Calendrier").Select
Range("E5").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("F5").Select
Selection.AutoFill Destination:=Range("E5:F5"), Type:=xlFillDefault
Range("E5:F5").Select
Rows("17:17").Select
Selection.AutoFill Destination:=Rows("14:17"), Type:=xlFillDefault
Rows("14:17").Select
Range("L7").Select
Selection.AutoFill Destination:=Range("L7:L9"), Type:=xlFillDefault
Range("L7:L9").Select
Range("AM10").Select
Sheets("Vacances").Select
Range("A18").Select
ActiveCell.FormulaR1C1 = "30/02014"
Range("B18").Select
ActiveCell.FormulaR1C1 = "3/2/2014"
Range("C21").Select
Sheets("Calendrier").Select
Range("B1").Select
Sheets("Vacances").Select
Range("A18").Select
ActiveCell.FormulaR1C1 = "30/02016"
Range("B18").Select
ActiveCell.FormulaR1C1 = "3/2/2016"
Range("C21").Select
Sheets("Calendrier").Select
Range("H23").Select
Sheets("Vacances").Select
Range("A18").Select
ActiveCell.FormulaR1C1 = "30/02)016"
Sheets("Vacances").Select
Range("A18").Select
ActiveCell.FormulaR1C1 = "30/02/2016"
Range("E11").Select
Sheets("Vacances").Select
Range("C9").Select
Sheets("Calendrier").Select
Range("W5:AA5").Select
Selection.AutoFill Destination:=Range("W4:AA5"), Type:=xlFillDefault
Range("W4:AA5").Select
Range("M21").Select
Sheets("Vacances").Select
Range("C22").Select
Sheets("Calendrier").Select
Range("E24").Select
Sheets("Calendrier").Select
ActiveWorkbook.Save
ActiveWorkbook.FollowHyperlink Address:= _
"http://odc.officeapps.live.com/odc/help/clientdeveloper?lcid=1036&syslcid=1036&uilcid=1036&ver=15&helpnamespace=EXCEL&helpid=vbaxl10.chm144076" _
, NewWindow:=False, AddHistory:=True
Application.Left = -14.75
Application.Top = 130.75
Range("E1").Select
Application.Left = 43
Application.Top = 130.75
ActiveWorkbook.Save
Sheets("Vacances").Select
Range("A18").Select
Application.Width = 669.75
Application.Height = 639
Range("B11").Select
Sheets("Vacances").Select
ActiveWindow.SmallScroll Down:=6
Range("A18").Select
ActiveCell.FormulaR1C1 = "2/27/2016"
Range("D8:D9").Select
ActiveWindow.SmallScroll Down:=-12
Range("A5").Select
Sheets("Calendrier").Select
Range("U5:V5").Select
Selection.AutoFill Destination:=Range("U4:V5"), Type:=xlFillDefault
Range("U4:V5").Select
Range("AB5:AC5").Select
Selection.AutoFill Destination:=Range("AB4:AC5"), Type:=xlFillDefault
Range("AB4:AC5").Select
Range("A30").Select
Sheets("Calendrier").Select
Range("D20").Select
Sheets("Calendrier").Select
Range("E1").Select
ActiveCell.FormulaR1C1 = "2"
Range("E1").Select
ActiveCell.FormulaR1C1 = "2"
Range("F1").Select
Sheets("Calendrier").Select
ActiveWorkbook.Save
End Sub
Bonjour,
Il te faut supprimer tous les "Select" et "Activate" du code et les remplacer par l'objet qu'ils représentent comme par exemple ces premières lignes :
With Range("B4:AF12")
.FormatConditions.Add Type:=xlExpression, Formula1:="=JOURSEM(B$3;2)>5"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
'...
au lieu de :
Range("B4:AF12").Select
Range("B6").Activate
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=JOURSEM(B$3;2)>5"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
'...
Les sélections et activations d'objet ralentissent fortement l'exécution d'un code c'est pour cette raison qu'elles sont déconseillées !
Hervé.
Merci Theze,
J'ai suivi tes recommandations mais le problème persiste en soi, quant à la lenteur persiste. Merci