5 mises en forme conditionnelles

debutant03 -  
Bonjour,

Ne connaissant pas du tout les macros ni le VBA, je souhaiterais savoir comment mettre en forme condtionnelle une plage de cellules selon le code suivant :
- si cellule=0 affichage de la cellule en gris
- si cellule=1 affichage en rouge
- si cellule=2 affichage en orange
- si cellule=3 affichage en vert
- si cellule=4 affichage en bleu

Ma matrice s'étend de G10 à DT210.

Merci d'avance pour toutes vos réponses.

10 réponses

  • Votes
  • Date
  • Date décroissante
  1. lermite222 Contributeur
    Mais si tu tient vraiment à le faire en VBA, un code optimiser et avec détection d'erreur. 
    Private Sub Worksheet_Change(ByVal Target As Range) 
    If Target.Count > 1 Then Exit Sub 'éviter les plantage quand sélectionne un bloc de cellule 
    If IsNumeric(Target) Then 
        With Target.Interior 
        Select Case Target 
        Case 0: .ColorIndex = 15 
        Case 1: .ColorIndex = 3 
        Case 2: .ColorIndex = 45 
        Case 3: .ColorIndex = 4 
        Case 4: .ColorIndex = 41 
        Case Else: .ColorIndex = xlNone
        End Select
        End With
    Else
        Target.Interior.ColorIndex = xlNone
    End If 
End Sub

    En cas d'effacement changer le format de la cellule par du texte (une cellule vide étant assimilée à zéro) ou taper une apostrophe dans la cellule.
    A+
    L'expérience instruit plus sûrement que le conseil. (André Gide)
    Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
    1. f894009
      Bonjour,

      Ouvrez votre classeur EXCEL, ensuite appuyez sur les touches Alt et F11 pour ouvrir le VBA. Double Click à gauche sur ThisWorkbook et copier le code ci-dessous dans la fenêtre qui s'est ouverte. Enregistrer. Revenez sur le classeur EXECEL. Essayez

      Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

      Cellule_Modifiee = Target.Address

      If Range(Cellule_Modifiee).Value = 0 Then
      Range(Cellule_Modifiee).Select
      With Selection.Interior
      .ColorIndex = 15
      .Pattern = xlSolid
      End With
      ElseIf Range(Cellule_Modifiee).Value = 1 Then
      Range(Cellule_Modifiee).Select
      With Selection.Interior
      .ColorIndex = 3
      .Pattern = xlSolid
      End With
      ElseIf Range(Cellule_Modifiee).Value = 2 Then
      Range(Cellule_Modifiee).Select
      With Selection.Interior
      .ColorIndex = 45
      .Pattern = xlSolid
      End With
      ElseIf Range(Cellule_Modifiee).Value = 3 Then
      Range(Cellule_Modifiee).Select
      With Selection.Interior
      .ColorIndex = 4
      .Pattern = xlSolid
      End With
      ElseIf Range(Cellule_Modifiee).Value = 4 Then
      Range(Cellule_Modifiee).Select
      With Selection.Interior
      .ColorIndex = 41
      .Pattern = xlSolid
      End With
      Else

      End If

      End Sub

      Il n'y a pas le code pour tester que les cellules modifiées sont dans la plage de votre matrice.

      Bonne continuation
      1. debutant03
        Merci beaucoup c'est génial... J'abuse mais comment attribuer la même couleur de police que le fond ? Que quand je tape mes chiffres ne soit visualisée qu'une plage de couleurs sans que le chiffre soit visible.
    2. f894009
      Rebonjour,

      Remplacez le code par celui-ci

      Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

      Cellule_Modifiee = Target.Address

      If Range(Cellule_Modifiee).Value = 0 Then
      Range(Cellule_Modifiee).Select
      Selection.Font.ColorIndex = 15
      With Selection.Interior
      .ColorIndex = 15
      .Pattern = xlSolid
      End With
      ElseIf Range(Cellule_Modifiee).Value = 1 Then
      Range(Cellule_Modifiee).Select
      Selection.Font.ColorIndex = 3
      With Selection.Interior
      .ColorIndex = 3
      .Pattern = xlSolid
      End With
      ElseIf Range(Cellule_Modifiee).Value = 2 Then
      Range(Cellule_Modifiee).Select
      Selection.Font.ColorIndex = 45
      With Selection.Interior
      .ColorIndex = 45
      .Pattern = xlSolid
      End With
      ElseIf Range(Cellule_Modifiee).Value = 3 Then
      Range(Cellule_Modifiee).Select
      Selection.Font.ColorIndex = 4
      With Selection.Interior
      .ColorIndex = 4
      .Pattern = xlSolid
      End With
      ElseIf Range(Cellule_Modifiee).Value = 4 Then
      Range(Cellule_Modifiee).Select
      Selection.Font.ColorIndex = 41
      With Selection.Interior
      .ColorIndex = 41
      .Pattern = xlSolid
      End With
      Else

      End If

      End Sub
      1. debutant03
        Franchement, milles merci pour tout.... Réponse super rapide et cela fonctionne parfaitement. Encore merci à vous !!!
      2. debutant03
        Comment appliquer ce code à plusieurs feuilles?
    3. lermite222 Contributeur
      Bonjour,
      Si tu a Excel 2007 ou >, tu peu employer une Mise en forme conditionelle
      A+
      2. lermite222 Contributeur
        Si ta plage contient déja des données tu peu actualiser avec..
        Coller ce code dans le module de la feuille concernée. 
        Sub Couleur()
Dim Cel As Range
    For Each Cel In Range("G10:DT210")
        If IsNumeric(Cel) Then
            With Cel.Interior
                Select Case Cel
                Case 0: .ColorIndex = 15
                Case 1: .ColorIndex = 3
                Case 2: .ColorIndex = 45
                Case 3: .ColorIndex = 4
                Case 4: .ColorIndex = 41
                End Select
            End With
        End If
    Next
End Sub

        Mettre le curseur au milieu de la macro et taper F5
        A+
        L'expérience instruit plus sûrement que le conseil. (André Gide)
        Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
        1. debutant03
          Une dernière question pour f894009, si je supprime une cellule déjà renseignée, un message d'erreur de type "erreur d'exécution '13' incompatibilité de type" apparaît. Et le fond de ma cellule reste. Comment éviter ce phénomène? Je voudrais que le fond disparaisse si je supprime le contenu de la cellule. Est-ce possible? Etant un document à diffuser je souhaiterais que les utilisateurs (niveau encore plus basique que moi) n'aient pas à avoir affaire à l'editor VBA. Merci encore d'avance.
        2. lermite222 Contributeur
          Bah... j'ai la solution mais vu que c'est pour f894009
        3. debutant03
          Ben c'est surtout parce que c'était f894009 qui avait rédigé le code mais tu te doutes bien lermite que je suis preneur si tu as une solution lol
        4. lermite222 Contributeur
          Fait.. Reprend mon premier code.
      3. Xymo
        Ce genre de fonctionnalité est déjà intégrée à Excel, tu sélectionnes ta plage de cellules ( ici G10 à DT210 ) et après tu va dans Format > Mise en forme conditionnelle et là tu peux ajouter tes 5 conditions en spécifiant les couleurs pour chacune d'entre elles. Dans la liste choisis bien "égale à" . Voilà !
        1. lermite222 Contributeur
          Uniquement à partir de Excel 2007, avant 3 conditions maximum pour les MFC.
          D'ou mon premier poste !
      4. f894009
        Bonjour,

        Ce code remet la couleur ou le manque de couleur

        Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
        On Error Resume Next

        Cellule_Modifiee = Target.Address

        If Range(Cellule_Modifiee).Value = 0 And Not IsEmpty(Range(Cellule_Modifiee).Value) Then
        Range(Cellule_Modifiee).Select
        Selection.Font.ColorIndex = 15
        With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
        End With
        ElseIf Range(Cellule_Modifiee).Value = 1 Then
        Range(Cellule_Modifiee).Select
        Selection.Font.ColorIndex = 3
        With Selection.Interior
        .ColorIndex = 3
        .Pattern = xlSolid
        End With
        ElseIf Range(Cellule_Modifiee).Value = 2 Then
        Range(Cellule_Modifiee).Select
        Selection.Font.ColorIndex = 45
        With Selection.Interior
        .ColorIndex = 45
        .Pattern = xlSolid
        End With
        ElseIf Range(Cellule_Modifiee).Value = 3 Then
        Range(Cellule_Modifiee).Select
        Selection.Font.ColorIndex = 4
        With Selection.Interior
        .ColorIndex = 4
        .Pattern = xlSolid
        End With
        ElseIf Range(Cellule_Modifiee).Value = 4 Then
        Range(Cellule_Modifiee).Select
        Selection.Font.ColorIndex = 41
        With Selection.Interior
        .ColorIndex = 41
        .Pattern = xlSolid
        End With
        ElseIf IsEmpty(Range(Cellule_Modifiee)) Then
        Range(Cellule_Modifiee).Select
        Selection.Interior.ColorIndex = xlNone
        Selection.Font.ColorIndex = 0
        Else
        End If

        End Sub
        1. f894009
          Bonjour,
          Ce code marche pour toutes les feuilles du classeur
          1. debutant03
            Le problème étant que ma deuxième feuille est une copie de la 1ère.
            J'ai dans chaque celleule de la feuille 2 =SI(Feuille1!A1<>0,Feuille1;"") et copié dans toute la feuille.
            Du coup il n'y a pas de saisie direct dans la deuxième feuille.
            Mes chiffres sont bien reportés mais pas la mise en forme.
          2. lermite222 Contributeur
            MISE EN FORME CONDITIONELLE
          3. lermite222 Contributeur
            OU MA 2ém MACRO
        2. lermite222 Contributeur
          Pour que ça fonctionne sur toutes les feuilles ou sur plusieur...
          Supprimer les codes mis dans les modules des feuilles.
          Mettre dans le module de ThisWorkbook... 
          Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    'Si pas sur toutes les feuilles.. Sinon, enlever le 1er IF
    If Sh.Name = "Feuil1" Or Sh.Name = "Feuil2" Then
        If Target.Count > 1 Then Exit Sub 'éviter les plantage quand sélectionne un bloc de cellule
            If IsNumeric(Target) Then
            With Target.Interior
            Select Case Target
            Case 0: .ColorIndex = 15
            Case 1: .ColorIndex = 3
            Case 2: .ColorIndex = 45
            Case 3: .ColorIndex = 4
            Case 4: .ColorIndex = 41
            Case Else: .ColorIndex = xlNone
            End Select
            End With
        Else
            Target.Interior.ColorIndex = xlNone
        End If
    End If
End Sub

          A+
          1. f894009
            Re moi,

            Ce code remplace le précédent et il fait la copie sur la feuil2, il faut enlever les formules que vous avez mises sur cette feuille

            Dim x

            Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
            Application.ScreenUpdating = False
            Cellule_Modifiee = Target.Address
            x = x + 1
            If x > 1 Then x = 0: Exit Sub ' pour éviter une boucle de 234

            If Range(Cellule_Modifiee).Value = 0 And Not IsEmpty(Range(Cellule_Modifiee).Value) Then
            Range(Cellule_Modifiee).Select
            Selection.Font.ColorIndex = 15
            With Selection.Interior
            .ColorIndex = 15
            .Pattern = xlSolid
            End With
            Selection.Copy
            Call Copie_Données(Cellule_Modifiee)
            ElseIf Range(Cellule_Modifiee).Value = 1 Then
            Range(Cellule_Modifiee).Select
            Selection.Font.ColorIndex = 3
            With Selection.Interior
            .ColorIndex = 3
            .Pattern = xlSolid
            End With
            Selection.Copy
            Call Copie_Données(Cellule_Modifiee)
            ElseIf Range(Cellule_Modifiee).Value = 2 Then
            Range(Cellule_Modifiee).Select
            Selection.Font.ColorIndex = 45
            With Selection.Interior
            .ColorIndex = 45
            .Pattern = xlSolid
            End With
            Selection.Copy
            Call Copie_Données(Cellule_Modifiee)
            ElseIf Range(Cellule_Modifiee).Value = 3 Then
            Range(Cellule_Modifiee).Select
            Selection.Font.ColorIndex = 4
            With Selection.Interior
            .ColorIndex = 4
            .Pattern = xlSolid
            End With
            Selection.Copy
            Call Copie_Données(Cellule_Modifiee)
            ElseIf Range(Cellule_Modifiee).Value = 4 Then
            Range(Cellule_Modifiee).Select
            Selection.Font.ColorIndex = 41
            With Selection.Interior
            .ColorIndex = 41
            .Pattern = xlSolid
            End With
            Selection.Copy
            Call Copie_Données(Cellule_Modifiee)
            ElseIf IsEmpty(Range(Cellule_Modifiee)) Then
            Range(Cellule_Modifiee).Select
            Selection.Interior.ColorIndex = xlNone
            Selection.Font.ColorIndex = 0
            Selection.Copy
            Call Copie_Données(Cellule_Modifiee)
            Else
            End If
            Sheets("Feuil1").Select
            Application.CutCopyMode = False
            End Sub

            'Mise en forme feuil2
            '--------------------
            Sub Copie_Données(Cellule_Modifiee)
            Sheets("Feuil2").Select
            Range(Cellule_Modifiee).Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
            End Sub
            1. debutant03
              Bon allez dernière question pour mon satané doc et je n'embête plus personne cette fois : quand je supprime une ligne entière sur ma première feuille (sélection ligne puis Ctrl -), un message d'erreur apparaît et la suppression ne se répercute pas sur la seconde feuille... Une solution pour éviter ça?
            2. lermite222 Contributeur
              Inscrit-toi sur CCM, cela me permettra de t'envoyer un MP et de remettre les pendules à l'heure.

          Discussions similaires

          Comment annuler mise en forme tableau
          etiennette57

          8 réponses
          Colorer une cellule quand une autre est non vide
          Cé.

          4 réponses
          Comment télécharger GTA 5 dans la PPSSPP
          Nelson

          3 réponses
          Excel supprimer une mise en forme de tableau
          pépé35530

          24 réponses
          Mise en forme conditionnelle 2 conditions
          happydays

          7 réponses