Sujet Précédent Sujet Suivant

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

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

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

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

Discussions similaires

Boucle sur la première diapositive d'une présentation
ND83 -
ndubau -

3 réponses
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
Saison 5 de Kyle XY
Rose -
doudou59800 -

4 réponses