5 mises en forme conditionnelles

debutant03 -  
lermite222 Messages postés 9042 Statut Contributeur -
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

  1.
    lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    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
  2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    0
    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.
      0
  3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    0
    1. debutant03
       
      Franchement, milles merci pour tout.... Réponse super rapide et cela fonctionne parfaitement. Encore merci à vous !!!
      0
    2. debutant03
       
      Comment appliquer ce code à plusieurs feuilles?
      0
  4. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Bonjour,
    Si tu a Excel 2007 ou >, tu peu employer une Mise en forme conditionelle
    A+
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    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)
    0
    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.
      0
    2. lermite222 Messages postés 9042 Statut Contributeur 1 199
       
      Bah... j'ai la solution mais vu que c'est pour f894009
      0
    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
      0
    4. lermite222 Messages postés 9042 Statut Contributeur 1 199
       
      Fait.. Reprend mon premier code.
      0
  7. Xymo Messages postés 53 Statut Membre 6
     
    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à !
    0
    1. lermite222 Messages postés 9042 Statut Contributeur 1 199
       
      Uniquement à partir de Excel 2007, avant 3 conditions maximum pour les MFC.
      D'ou mon premier poste !
      0
  8. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    0
  9. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,
    Ce code marche pour toutes les feuilles du classeur
    0
    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.
      0
    2. lermite222 Messages postés 9042 Statut Contributeur 1 199
       
      MISE EN FORME CONDITIONELLE
      0
    3. lermite222 Messages postés 9042 Statut Contributeur 1 199
       
      OU MA 2ém MACRO
      0
  10. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    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+
    0
  11. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    0
    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?
      0
    2. lermite222 Messages postés 9042 Statut Contributeur 1 199
       
      Inscrit-toi sur CCM, cela me permettra de t'envoyer un MP et de remettre les pendules à l'heure.
      0

Discussions similaires

Mise en forme conditionnelle 2 conditions
happydays -
Emilie -

7 réponses
mise en forme conditionnelle avec 3 conditions
laurence -
yao.chris -

11 réponses
Mise en forme conditionnelle avec 2 conditions
Sly3d -
Sly3d -

5 réponses
raccourcis pinceau excel
miraje -
7.7 -

15 réponses
Comment annuler mise en forme tableau
etiennette57 -
Nedjma -

8 réponses