Optimiser mon code
Bonjour à tous,
Dans un soucis d'apprentissage, je souhaiterais vous solliciter pour m'aider à améliorer l'écriture de macro.
J'ai écris ce code pour me permettre de poser automatiquement des MFC dans une plage spécifique de cellules, sur 52 feuilles.
Le code fonctionne très bien mais à chaque changement d'onglet, l'exécution ralentit...
Sub MFC()
Dim Mdp As String
Mdp = Application.InputBox("Veuillez introduire votre mot de passe :")
If Mdp <> "mdp" Then MsgBox "Accès refusé !": Exit Sub
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name Like "Semaine*" Then
ws.Unprotect "mdp"
With ws.Range("C12:L13,C15:J29,C31:J33,C35:J40,C42:J44,N11:N30")
.FormatConditions.Delete
'Type := 9 => xlTextString
'Type := 1 => xlCellValue
'TextOperator := 0 => xlContains
.FormatConditions.Add Type:=9, _
String:="02", _
TextOperator:=0
.FormatConditions(1).Interior.Color = RGB(255, 153, 0)
.FormatConditions.Add Type:=9, _
String:="IH - Routine", _
TextOperator:=0
.FormatConditions(2).Interior.Color = RGB(234, 241, 221)
.FormatConditions.Add Type:=9, _
String:="IH - Urgence", _
TextOperator:=0
.FormatConditions(3).Interior.Color = RGB(234, 241, 221)
.FormatConditions.Add Type:=9, _
String:="IH - Routine / IH - Urgence", _
TextOperator:=0
.FormatConditions(4).Interior.Color = RGB(234, 241, 221)
.FormatConditions.Add Type:=9, _
String:="Panel", _
TextOperator:=0
.FormatConditions(5).Interior.Color = RGB(252, 213, 180)
.FormatConditions.Add Type:=9, _
String:="Panel +", _
TextOperator:=0
.FormatConditions(6).Interior.Color = RGB(252, 213, 180)
.FormatConditions.Add Type:=9, _
String:="Don", _
TextOperator:=0
.FormatConditions(7).Interior.Color = RGB(194, 214, 154)
.FormatConditions.Add Type:=9, _
String:="Type", _
TextOperator:=0
.FormatConditions(8).Interior.Color = RGB(209, 255, 246)
.FormatConditions.Add Type:=9, _
String:="DIS 1", _
TextOperator:=0
.FormatConditions(9).Interior.Color = RGB(255, 204, 255)
.FormatConditions.Add Type:=9, _
String:="DIS 2", _
TextOperator:=0
.FormatConditions(10).Interior.Color = RGB(247, 147, 147)
.FormatConditions.Add Type:=9, _
String:="Soir IH", _
TextOperator:=0
With .FormatConditions(11)
.Interior.Color = RGB(83, 142, 213)
.Font.ColorIndex = 2
End With
.FormatConditions.Add Type:=9, _
String:="SXM", _
TextOperator:=0
With .FormatConditions(12)
.Interior.Color = RGB(83, 142, 213)
.Font.ColorIndex = 2
End With
.FormatConditions.Add Type:=9, _
String:="BIOMOL", _
TextOperator:=0
.FormatConditions(13).Interior.Color = RGB(255, 255, 153)
.FormatConditions.Add Type:=9, _
String:="Garde", _
TextOperator:=0
.FormatConditions(14).Interior.Color = RGB(243, 71, 71)
.FormatConditions.Add Type:=9, _
String:="Nuit", _
TextOperator:=0
With .FormatConditions(15)
.Interior.Color = RGB(23, 55, 93)
.Font.ColorIndex = 2
End With
.FormatConditions.Add Type:=9, _
String:="DM", _
TextOperator:=0
.FormatConditions(16).Interior.Color = RGB(146, 208, 80)
.FormatConditions.Add Type:=9, _
String:="RE", _
TextOperator:=0
.FormatConditions(17).Interior.Color = RGB(216, 216, 216)
.FormatConditions.Add Type:=9, _
String:="CH", _
TextOperator:=0
.FormatConditions(18).Interior.Color = RGB(216, 216, 216)
.FormatConditions.Add Type:=9, _
String:="01", _
TextOperator:=0
.FormatConditions(19).Interior.Color = RGB(204, 102, 255)
.FormatConditions.Add Type:=9, _
String:="36", _
TextOperator:=0
.FormatConditions(20).Interior.Color = RGB(204, 153, 255)
.FormatConditions.Add Type:=9, _
String:="F1", _
TextOperator:=0
.FormatConditions(21).Interior.Color = RGB(234, 241, 221)
.FormatConditions.Add Type:=9, _
String:="F2", _
TextOperator:=0
.FormatConditions(22).Interior.Color = RGB(215, 228, 188)
.FormatConditions.Add Type:=9, _
String:="F3", _
TextOperator:=0
.FormatConditions(23).Interior.Color = RGB(194, 214, 154)
.FormatConditions.Add Type:=9, _
String:="W1", _
TextOperator:=0
.FormatConditions(24).Interior.Color = RGB(234, 241, 221)
.FormatConditions.Add Type:=9, _
String:="W2", _
TextOperator:=0
.FormatConditions(25).Interior.Color = RGB(215, 228, 188)
.FormatConditions.Add Type:=9, _
String:="W3", _
TextOperator:=0
.FormatConditions(26).Interior.Color = RGB(194, 214, 154)
.FormatConditions.Add Type:=9, _
String:="Examen", _
TextOperator:=0
.FormatConditions(27).Interior.Color = RGB(255, 0, 102)
.FormatConditions.Add Type:=9, _
String:="Formation", _
TextOperator:=0
.FormatConditions(28).Interior.Color = RGB(123, 240, 255)
.FormatConditions.Add Type:=9, _
String:="RQ", _
TextOperator:=0
.FormatConditions(29).Interior.Color = RGB(255, 0, 255)
End With
With ws.Range("P11:T30")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
, Formula1:="1"
.FormatConditions(1).Interior.Color = RGB(215, 228, 188)
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual _
, Formula1:="0"
.FormatConditions(2).Interior.Color = RGB(230, 185, 184)
End With
End If
ws.Protect "mdp"
Next ws
End Sub
Que pourrais-je faire pour optimiser l'écriture et la rapidité d'exécution ?
Bonjour,
Ça en fait pas mal !
Il me semble que toutes feuilles devant être issues d'un même modèle, l'insertion des MFC au niveau du modèle éviterait d'avoir à s'en préoccuper par la suite ! Ce qui serait un gain conséquent.
Comme plus de 99% des MFC que je suis amené à faire le sont sur formule, je procède de même en VBA, cela réduit les arguments à passer :
With .FormatConditions.Add(xlExpression, , "=C12=""Panel""")
Interior.Color = RGB(..., ..., ...)
End With
La formule est acceptée telle que formulée manuellement dans Excel...
Mais je maintiens que hormis les cas où des changements obligent à effacer et réinsérer les MFC régulièrement, leur mise en place préalable à la création est préférable.
Cordialement.
Bonjour MFerrand,
J'ai fais ce choix de MFC par VBA car c'est un fichier partagé sur de nombreux postes, et de nombreux changements sont faits au quotidien.
Les utilisateurs utilisent des copier/coller, et malgré ce code qui est censé ne coller que les valeurs :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
On Error Resume Next 'sécurité
With Application
If .CutCopyMode Then
.EnableEvents = False
.Undo
Selection.PasteSpecial xlPasteValues
.OnUndo "", ""
.OnRepeat "", ""
.EnableEvents = True
End If
End With
End Sub
beaucoup d'entre eux n'activent pas les macros à l'ouverture du fichier, ce qui fait qu'en quelques semaines, le fichier ne ressemble plus à rien
Je pense que c'est la meilleure solution, mais je suis preneur si tu as d'autres idées...
Bonne journée !
Bonjour,
Avec autant de FormatConditions, difficile de réduire fortement le code. Ici j'utilise un tableau à deux dimensions. Je ne peux pas tester (Excel 2003) mais regarde quel est le résultat :
Sub MFC()
Dim Tbl(1 To 2, 1 To 29)
Dim ws As Worksheet
Dim Mdp As String
Dim I As Integer
Mdp = Application.InputBox("Veuillez introduire votre mot de passe :")
If Mdp <> "mdp" Then MsgBox "Accès refusé !": Exit Sub
Tbl(1, 1) = "02": Tbl(2, 1) = RGB(255, 153, 0)
Tbl(1, 2) = "IH - Routine": Tbl(2, 2) = RGB(234, 241, 221)
Tbl(1, 3) = "IH - Urgence": Tbl(2, 3) = RGB(234, 241, 221)
Tbl(1, 4) = "IH - Routine / IH - Urgence": Tbl(2, 4) = RGB(234, 241, 221)
Tbl(1, 5) = "Panel": Tbl(2, 5) = RGB(252, 213, 180)
Tbl(1, 6) = "Panel +": Tbl(2, 6) = RGB(252, 213, 180)
Tbl(1, 7) = "Don": Tbl(2, 7) = RGB(194, 214, 154)
Tbl(1, 8) = "Type": Tbl(2, 8) = RGB(209, 255, 246)
Tbl(1, 9) = "DIS 1": Tbl(2, 9) = RGB(255, 204, 255)
Tbl(1, 10) = "DIS 2": Tbl(2, 10) = RGB(247, 147, 147)
Tbl(1, 11) = "Soir IH": Tbl(2, 11) = RGB(83, 142, 213)
Tbl(1, 12) = "SXM": Tbl(2, 12) = RGB(83, 142, 213)
Tbl(1, 13) = "BIOMOL": Tbl(2, 13) = RGB(255, 255, 153)
Tbl(1, 14) = "Garde": Tbl(2, 14) = RGB(243, 71, 71)
Tbl(1, 15) = "Nuit": Tbl(2, 15) = RGB(23, 55, 93)
Tbl(1, 16) = "DM": Tbl(2, 16) = RGB(146, 208, 80)
Tbl(1, 17) = "RE": Tbl(2, 17) = RGB(216, 216, 216)
Tbl(1, 18) = "CH": Tbl(2, 18) = RGB(216, 216, 216)
Tbl(1, 19) = "01": Tbl(2, 19) = RGB(204, 102, 255)
Tbl(1, 20) = "36": Tbl(2, 20) = RGB(204, 153, 255)
Tbl(1, 21) = "F1": Tbl(2, 21) = RGB(234, 241, 221)
Tbl(1, 22) = "F2": Tbl(2, 22) = RGB(215, 228, 188)
Tbl(1, 23) = "F3": Tbl(2, 23) = RGB(194, 214, 154)
Tbl(1, 24) = "W1": Tbl(2, 24) = RGB(234, 241, 221)
Tbl(1, 25) = "W2": Tbl(2, 25) = RGB(215, 228, 188)
Tbl(1, 26) = "W3": Tbl(2, 26) = RGB(194, 214, 154)
Tbl(1, 27) = "Examen": Tbl(2, 27) = RGB(255, 0, 102)
Tbl(1, 28) = "Formation": Tbl(2, 28) = RGB(123, 240, 255)
Tbl(1, 29) = "RQ": Tbl(2, 29) = RGB(255, 0, 255)
For Each ws In Worksheets
If ws.Name Like "Semaine*" Then
ws.Unprotect "mdp"
With ws.Range("C12:L13,C15:J29,C31:J33,C35:J40,C42:J44,N11:N30")
.FormatConditions.Delete
'Type := 9 => xlTextString
'Type := 1 => xlCellValue
'TextOperator := 0 => xlContains
For I = 1 To UBound(Tbl, 2)
Select Case I
Case 1 To 10, 13, 14, 16 To 29
.FormatConditions.Add Type:=9, String:=Tbl(1, I), TextOperator:=0
.FormatConditions(I).Interior.Color = Tbl(2, I)
Case 11, 12, 15
.FormatConditions.Add Type:=9, String:=Tbl(1, I), TextOperator:=0
With .FormatConditions(I)
.Interior.Color = Tbl(2, I)
.Font.ColorIndex = 2
End With
End Select
Next I
End With
With ws.Range("P11:T30")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="1"
.FormatConditions(1).Interior.Color = RGB(215, 228, 188)
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="0"
.FormatConditions(2).Interior.Color = RGB(230, 185, 184)
End With
End If
ws.Protect "mdp"
Next ws
End Sub
Bonjour Theze, le forum,
Merci pour ta proposition très intéressante, le code est effectivement plus concis, mais malheureusement la vitesse d’exécution est identique au mien
Ça me permet d'améliorer mon écriture, merci beaucoup !