Comment contourner cette limite de 3 critères pour la Mise en Forme Conditionnelle Excel ?

De nombreuses solutions sont ainsi proposées...

• Il est possible notamment de gérer jusqu'à 7 conditions grâce à une astucieuse combinaison de MFC classique et de format de nombres spécifique (Alain Vallon l'illustre parfaitement dans un classeur exemple très explicite que vous trouverez sur Excelabo : le fichier se nomme av-7couleursconditionnelles.
  
  
• Et pour aller au delà, de nombreuses solutions à base de langage VBA font généralement le bonheur des demandeurs. Ces solutions souffrent par contre d'un problème important : elles requièrent un code en accord avec chaque situation exposée et demandent donc une certaine connaissance (voire une maitrise) du langage de programmation pour pouvoir adapter la proposition au projet réel et en assurer les modifications futures...

Historique de mDF MFCmultiples

L'idéal serait de proposer une procédure VBA :

C'est donc en réfléchissant sur ces quatre points que j'ai proposé la toute première version de mDF MFCmultiples sur le forum Excel-Downloads en Septembre 2004, dans le fil de discussions : Couleur cellule selon valeur .
J'expliquais dans ce fil les principes de fonctionnement retenus, qui restent d'ailleurs aujourd'hui toujours valables... L'objectif d'alors : détourner, en toute transparence (enfin... presque !), la vraie MFC pour en prendre le contrôle et assurer le traitement par VBA.

C'est un an plus tard que je présentais une deuxième version améliorée, toujours dans le forum d'XLD, dans le fil : Planning couleurs selon saisie.

Et c'est aujourd'hui (seulement ) que je vous présente la dernière mouture de cette macro, complètement revue, améliorée et optimisée.

Cette nouvelle version mDF MFCmultiples v5.0 permet :

Téléchargez le classeur exemple de la dernière version : 



Mise en oeuvre

Préparatifs (2 étapes) :

1. Il convient de créer un nouvel onglet nommé MFC dans le classeur cible. Cet onglet contiendra en colonne A, tous les critères et formats associés que l'utilisateur ou le concepteur du document pourra modifier à sa guise. Les critères saisis seront automatiquement triés par la macro dès l'activation d'un autre onglet. Bien sûr, cette feuille « MFC » peut ensuite être masqué pour utilisation finale.
   
   
   
   
   
2. Copiez-collez ensuite l'ensemble du code VBA suivant, dans le module de code de l'objet ThisWorkbook de votre classeur :

   
   

   DANS LE MODULE DE CODE DE L'OBJET THISWORKBOOK

   Option Explicit 
   '--------------------------------------------------------------------------------------- 
   ' Auteur    : Didier FOURGEOT (myDearFriend!) - www.mdf-xlpages.com 
   ' Date      : 21/03/2008 
   ' Sujet     : mDF MFCmultiples v5.0 
   '--------------------------------------------------------------------------------------- 
   Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
   Dim FCible As Range, RCible As Range, Cible As Range, Plage As Range, T As Range, _
   	Tplage As Range, PlageFC As Range 
   Dim Adr As String 
   Dim N As Boolean, B As Boolean, P As Boolean, A As Boolean, VFC As Boolean 
       On Error Resume Next 
       Set PlageFC = Sh.Cells.SpecialCells(xlCellTypeAllFormatConditions) 
       If PlageFC Is Nothing Then Exit Sub 
       'Définition de la Plage cible 
       Set Plage = Target 
       Set Tplage = Plage.Dependents 
       Set Plage = Application.Union(Plage, Tplage) 
       On Error GoTo 0 
       Set Plage = Application.Intersect(Plage, PlageFC) 
       If Plage Is Nothing Then Exit Sub 
       Application.ScreenUpdating = False 
       Set Tplage = Nothing 
       For Each T In Plage 
           VFC = VerifFCond(T) 
           If VFC Then 
               If Tplage Is Nothing Then 
                   Set Tplage = T 
               Else 
                   Set Tplage = Union(Tplage, T) 
               End If 
           End If 
       Next T 
       'Traitement de la plage Cible 
       If Not Tplage Is Nothing Then 
           With ActiveWorkbook.Styles("Normal") 
               N = .IncludeNumber 
               B = .IncludeBorder 
               P = .IncludeProtection 
               A = .IncludeAlignment 
               .IncludeNumber = False 
               .IncludeBorder = False 
               .IncludeProtection = False 
               .IncludeAlignment = False 
           End With 
           For Each Cible In Tplage 
               Set FCible = FormatCible(Cible) 
               Set RCible = Nothing 
               On Error Resume Next 
               With Cible 
                   Adr = Mid(.ID, 3) 
                   Select Case Adr 
                   Case "Cel" 
                       Set RCible = Cible 
                   Case "Lig" 
                       Set RCible = Application.Intersect(.EntireRow, ActiveSheet.UsedRange) 
                   Case Else 
                       Adr = Replace(Adr, ";", ",") 
                       If Val(Replace(Adr, "$", "")) > 0 Then 
                           Set RCible = Application.Intersect(.EntireColumn, Range(Adr)) 
                       Else 
                           Set RCible = Application.Intersect(.EntireRow, Range(Adr)) 
                       End If 
                   End Select 
               End With 
               On Error GoTo 0 
               If Not RCible Is Nothing Then 
                   With RCible 
                       If FCible.Row = 65536 Then 
                           'Format standard 
                           .Style = "Normal" 
                       Else 
                           'Format MFC 
                           With .Font 
                               .Bold = FCible.Font.Bold 
                               .Color = FCible.Font.Color 
                               .Italic = FCible.Font.Italic 
                               .Name = FCible.Font.Name 
                               .Size = FCible.Font.Size 
                               .Strikethrough = FCible.Font.Strikethrough 
                               .Subscript = FCible.Font.Subscript 
                               .Superscript = FCible.Font.Superscript 
                               .Underline = FCible.Font.Underline 
                           End With 
                           With .Interior 
                               .Color = FCible.Interior.Color 
                               .Pattern = FCible.Interior.Pattern 
                               .PatternColor = FCible.Interior.PatternColor 
                           End With 
                       End If 
                   End With 
               End If 
           Next Cible 
           With ActiveWorkbook.Styles("Normal") 
               .IncludeNumber = N 
               .IncludeBorder = B 
               .IncludeProtection = P 
               .IncludeAlignment = A 
           End With 
       End If 
       Application.ScreenUpdating = True 
   End Sub 
    
   Private Function VerifFCond(C As Range) As Boolean 
   Dim FCF As String, Op As String 
       On Error Resume Next 
       With C.FormatConditions(1) 
           FCF = .Formula1 
           Op = CStr(.Operator) 
       End With 
       On Error GoTo 0 
        
       Select Case Val(Op) 
       Case 3, 5 To 8 
           Op = Op & "|" 
       Case Else 
           Exit Function 
       End Select 
        
       VerifFCond = True 
       Select Case Left(FCF, 5) 
       Case "=mDF" 
           C.ID = Op & "Cel" 
       Case "=mDF(" 
           If FCF = "=mDF()" Then 
               C.ID = Op & "Lig" 
           Else 
               C.ID = Op & Replace(Replace(FCF, ")", ""), "=mDF(", "") 
           End If 
       Case Else 
           C.ID = "" 
           VerifFCond = False 
       End Select 
   End Function 
    
   Private Function FormatCible(Cible As Range) As Range 
   Dim C As Range 
   Dim L As Variant, Veg As Variant, Veginf As Variant 
       With Sheets("MFC") 
           If Not IsEmpty(Cible) Then 
               If Not (Val(Cible.ID) > 3 And Not IsNumeric(Cible.Value)) Then 
                   Veg = Application.Match(Cible.Value, .Columns(1), 0) 
                   Veginf = Application.Match(Cible.Value, .Columns(1), 1) 
                   Select Case Val(Cible.ID) 
                   Case 3  '= 
                       L = IIf(IsError(Veg), 0, Veg) 
                   Case 5  '> 
                       L = IIf(IsError(Veginf), 0, Veginf) - 1 
                   Case 6  '< 
                       L = Application.Max(IIf(IsError(Veginf), 0, Veginf) + 1, 2) 
                   Case 7  '>= 
                       L = IIf(IsError(Veg), 0, Veg) 
                       If L = 0 Then 
                           L = IIf(IsError(Veginf), 0, Veginf) 
                       End If 
                   Case 8  '<= 
                       L = IIf(IsError(Veg), 0, Veg) 
                       If L = 0 Then 
                           L = Application.Max(IIf(IsError(Veginf), 0, Veginf) + 1, 2) 
                       End If 
                   End Select 
                   If L > 1 Then 
                       Set C = .Cells(L, 1) 
                   End If 
               End If 
           End If 
           If C Is Nothing Then Set C = .Cells(65536, 1) 
       End With 
       Set FormatCible = C 
   End Function 
    
   Private Sub Workbook_SheetDeactivate(ByVal Sh As Object) 
   'Trie automatiquement les critères de l'onglet MFC 
       If Sh.Name = "MFC" Then 
           Application.ScreenUpdating = False 
           With Sh 
               .Columns(1).Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlGuess, _ 
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 
           End With 
           Application.ScreenUpdating = True 
       End If 
   End Sub

   
   

   Comment faire ?

C'est tout !
Votre classeur est maintenant prêt pour tirer bénéfice de cette macro.


Utilisation :

• Sélectionnez la (ou les) cellule(s) cible(s)
• Faites menu Format / Mise en forme conditionnelle...
• Dans Condition 1 : choisissez « La valeur de la cellule est »
• Dans la liste déroulante, sélectionnez un des comparateurs supportés par cette macro, soit :
  
  • « égale à »
  • « inférieur à »
  • « inférieur ou égale à »
  • « supérieur à »
  • « supérieur ou égale à »
• Dans la zone de critère, saisissez le critère spécial comme suit :
  
  • Pour agir sur une cellule isolée :  =mDF
  • Pour agir sur une ligne entière de données :   =mDF()
  • Pour agir sur une partie de la ligne de données :   =mDF($C:$H)
  • Pour agir sur plusieurs parties de la ligne de données :   =mDF($C:$H;$K:$K;$P:$T)
  • Pour agir sur la colonne de données :   =mDF($1:$45)
  • Pour agir sur plusieurs parties de la colonne de données :   =mDF($5:$18;$22:$25)

Nb : utilisez impérativement des références de plages (lignes/colonnes) absolues (utilisation du signe $).
Les différentes plages doivent être séparées par un point-virgule (;).

Exemples

Considérons l'onglet MFC suivant :



Et le tableau ci-dessous dans une feuille du même classeur :



J'ai appliqué des Mises en Forme Conditionnelles spéciales dans chaque cellule de la colonne B :

• En cellule B2, j'ai appliqué la MFC suivante :
  
  

  Comparateur	Critère
  égale à	=mDF

  
  Si je saisis la valeur 1000 dans cette cellule, j'obtiens ce résultat :
  
  
  
  L'effet aurait été identique si la valeur 1000 était issue du résultat d'une formule.

• En cellule B3, j'ai appliqué la MFC suivante :
  

   

  Comparateur	Critère
  supérieure ou égale à	=mDF

  Si je saisis la valeur 5783 dans cette cellule, j'obtiens ce résultat :
  
  
  
  
  

   

• En cellule B4, j'ai appliqué la MFC suivante :
  

   

  Comparateur	Critère
  supérieure ou égale à	=mDF()

  
  Si je saisis la valeur 40083 dans cette cellule, j'obtiens ce résultat :
  
  
  
  
  

   

• En cellule B5, j'ai appliqué la MFC suivante :
  

   

  Comparateur	Critère
  inférieure à	=mDF($B:$B;$D:$E)

  
  Si je saisis la valeur 3161 dans cette cellule, j'obtiens ce résultat :
  
  

Autre exemple :

Démonstration

Vous trouverez et pourrez tester dans le fichier Exemple en téléchargement un panel des possibilités de cette macro.



Limites de cette macro et points de vigilance