Problème de lenteur de mon code VBA

Bonjour à tous,

J'ai un fichier avec un peu de code VBA pour automatiser une mise en forme.
Cependant je trouve le code très long.
Je sais que l'utilisation du .select alourdit toujours les procédures VBA mais je ne sais pas trop comment l'améliorer étant novice.
Pouvez-vous m’aiguiller sur une amélioration de mon code s'il vous plaît ?

le voici :

Dim range As range
Dim cell As range
Dim cb As CheckBox
Dim i As Integer
Dim MaPlage As range

Sub Boutonajoutligne()

ActiveSheet.Unprotect "mc16c"
ActiveCell.EntireRow.Insert Shift:=xlDown
ActiveCell.Offset(-1, 0).EntireRow.Copy Cells(ActiveCell.Row, 1)
On Error Resume Next
ActiveCell.EntireRow.SpecialCells(xlCellTypeConstants, xlNumbers + _
xlTextValues + _
xlLogical + _
xlErrors).ClearContents
Selection.Locked = False
ActiveSheet.Protect Password:="mc16c", DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingRows:=True, _
AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
Cells(ActiveCell.Row, 1).Select

End Sub

Sub Boutonsupprligne()
ActiveSheet.Unprotect "mc16c"
ActiveCell.Select
Selection.EntireRow.Delete
ActiveSheet.Protect Password:="mc16c", DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingRows:=True, _
AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
End Sub

Sub typeUE()

ActiveCell.Select
Cells(ActiveCell.Row, 1).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Selection.Font.Bold = False
Selection.Font.Bold = True
Cells(ActiveCell.Row, 2).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Selection.Font.Bold = False
Selection.Font.Bold = True
Cells(ActiveCell.Row, 3).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Selection.Font.Bold = False
Selection.Font.Bold = True
Cells(ActiveCell.Row, 4).Select

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Selection.Font.Bold = False
Selection.Font.Bold = True
End Sub

Sub TypeECUE()
'
ActiveCell.Select
Cells(ActiveCell.Row, 1).Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0.349986266670736
End With

Cells(ActiveCell.Row, 2).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 2
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0.349986266670736
End With

End Sub

Sub proc_annuler()
ActiveCell.Select
Cells(ActiveCell.Row, 1).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
Selection.Font.Bold = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells(ActiveCell.Row, 2).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
Selection.Font.Bold = False
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells(ActiveCell.Row, 3).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
Selection.Font.Bold = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
If Cells(ActiveCell.Row, 3) = "C" Then
Cells(ActiveCell.Row, 3) = ""
End If

Cells(ActiveCell.Row, 4).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
Selection.Font.Bold = False
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

End Sub

Sub Choix()
'
' Choix Macro
'
ActiveCell.Select
Cells(ActiveCell.Row, 1).Select
With Selection.Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 90
.Gradient.ColorStops.Clear
End With
With Selection.Interior.Gradient.ColorStops.Add(0)
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
End With
With Selection.Interior.Gradient.ColorStops.Add(0.5)
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
End With
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells(ActiveCell.Row, 2).Select
With Selection.Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 90
.Gradient.ColorStops.Clear
End With
With Selection.Interior.Gradient.ColorStops.Add(0)
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
End With
With Selection.Interior.Gradient.ColorStops.Add(0.5)
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 2
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells(ActiveCell.Row, 3).Select
With Selection.Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 90
.Gradient.ColorStops.Clear
End With
With Selection.Interior.Gradient.ColorStops.Add(0)
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
End With
With Selection.Interior.Gradient.ColorStops.Add(0.5)
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
End With

Cells(ActiveCell.Row, 4).Select
With Selection.Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 90
.Gradient.ColorStops.Clear
End With
With Selection.Interior.Gradient.ColorStops.Add(0)
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
End With
With Selection.Interior.Gradient.ColorStops.Add(0.5)
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.399975585192419
End With

End Sub

-----

Merci d'avance de votre aide !

Cdlt,

2 réponses

  1. Modérateur
    En effet, l'utilisation d'ActiveCell et de .Select alourdit sérieusement le temps d'exécution.
    Pour travailler sur une cellule, préfère utiliser Cells(x,y).
    Un code que j'avais et qui prenait 1h30 en utilisant ActiveCell a été réduit à environ 10min de cette manière.
    0
    1. Merci Arkana0,

      Le soucis c'est que les procédures doivent se déclencher sur la ligne ou se trouve le curseur d’où le activecell.
      Est-il possible de garder cette notion de cellule active tout en améliorant le code ?

      Merci !
      0
    2. Modérateur
      Ça n'est pas un problème, tu ajoutes simplement une variable "x" qui prend la valeur "ActiveCell.row" et une variable "y" qui prend la valeur "ActiveCell.Column" en début de code, par exemple. Ensuite tu ne te réfères plus qu'à elles
      0
    3. Modérateur
      Et bien sûr tu fais la chasse aux "select" inutiles
      0
    4. @Arkana0Merci !
      Je vais tester ça !
      0
  2. Contributeur
    Bonjour,

    et ajoute
    Application.ScreenUpdating=False
    au début de tes procédures.
    eric
    0
    1. Merci eriiic !

      Je l'ai ajouté et c'est super ça aussi !
      En ajoutant les conseils de Arkana0 ça va le faire !
      Merci à vous !
      0