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

Rechercher des sujets similaires à "code vba lenteur execution"