XL 2019 colorer cellules sans utiliser de MFC (#post2)

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous 🙂

Ce #post fait suite à celui-ci : https://excel-downloads.com/threads/ne-pas-utiliser-les-mfc.20072995/#post-20557539
Résolu par mapomme a qui j'adresse un super "MERCI".

Les cellules J6 à J8 sont concernées
Pour ces cellules, j'ai fait des MFC pour les colorer selon leurs contenus :
=ET(H6<>"";CNUM(GAUCHE(H6;10))>AUJOURDHUI())
=ET(H6<>"";CNUM(GAUCHE(H6;10))<AUJOURDHUI())+1
=ET(H6<>"";DATEVAL(STXT(H6;9;2) & "/" & STXT(H6;6;2) & "/" & GAUCHE(H6;4))<=AUJOURDHUI()+1)
1672581306024.png

Ces MFC fonctionnent et permettent la coloration des cellules selon les dates contenues

Je souhaite ne plus utiliser de MFC et les remplacer par des codes vba mais je n'ai pas trouvé comment les coder.
Voudriez-vous m'aider encore une fois ?
En cas, je joins le fichier test.
Un grand merci à toutes et à tous...

Tous mes vœux de bonheur pour cette nouvelle année, prenez soin de vous.
🙂
 

Pièces jointes

Trier par date Trier par votes
Re,
Juste en rajoutant quelques lignes à la macro précédente :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [J2:J500]) Is Nothing Then
    Dim Couleur, Texte, Gras, Blanc, Noir, Rouge, Vert, Jaune
    Application.ScreenUpdating = False
    Blanc = vbWhite: Noir = vbBlack: Rouge = RGB(192, 0, 0): Vert = RGB(56, 87, 35): Jaune = RGB(255, 255, 204)
    Select Case Target
        Case "":                    Couleur = Blanc: Texte = Noir: Gras = False
        Case "Annulé":              Couleur = Rouge: Texte = Blanc: Gras = True
        Case "NPR":                 Couleur = Rouge: Texte = Blanc: Gras = True
        Case "RdV Fait":            Couleur = Vert: Texte = Blanc: Gras = True
        Case "RdV Fait Facturé":    Couleur = Vert: Texte = Blanc: Gras = True
        Case Else:                  Couleur = Blanc: Texte = Noir: Gras = False
    End Select
    If IsDate(Target) And Target <= Int(Now) + 1 Then
        Couleur = Rouge: Texte = Blanc: Gras = False
    Else
        Couleur = Jaune: Texte = Noir: Gras = False
    End If
    Target.Interior.Color = Couleur
    Target.Font.Color = Texte
    Target.Font.Bold = Gras
End If
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
J'ai vu, enfin je pense.
c'est mieux avec le code modifié :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [J2:J500]) Is Nothing Then
    Dim Couleur, Texte, Gras, Blanc, Noir, Rouge, Vert, Jaune
    Application.ScreenUpdating = False
    Blanc = vbWhite: Noir = vbBlack: Rouge = RGB(192, 0, 0): Vert = RGB(56, 87, 35): Jaune = RGB(255, 255, 204)
    Select Case Target
        Case "":                    Couleur = Blanc: Texte = Noir: Gras = False
        Case "Annulé":              Couleur = Rouge: Texte = Blanc: Gras = True
        Case "NPR":                 Couleur = Rouge: Texte = Blanc: Gras = True
        Case "RdV Fait":            Couleur = Vert: Texte = Blanc: Gras = True
        Case "RdV Fait Facturé":    Couleur = Vert: Texte = Blanc: Gras = True
        Case Else:                  Couleur = Blanc: Texte = Noir: Gras = False
    End Select
    If IsDate(Target) And Target <= Int(Now) + 1 Then
        Couleur = Rouge: Texte = Blanc: Gras = False
'    Else
'        Couleur = Jaune: Texte = Noir: Gras = False
    End If
    Target.Interior.Color = Couleur
    Target.Font.Color = Texte
    Target.Font.Bold = Gras
End If
End Sub
🙂
 
Vote positif 0 Vote négatif
Bonjour
c'est quand même formidable d'utiliser un If isdate..... après un select case
le tout dans un case true ça vous dirais?
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [J2:J500]) Is Nothing Then
        Dim Couleur, Texte, Gras, Blanc, Noir, Rouge, Vert, Jaune
        Application.ScreenUpdating = False
        Blanc = vbWhite: Noir = vbBlack: Rouge = RGB(192, 0, 0): Vert = RGB(56, 87, 35): Jaune = RGB(255, 255, 204)

        Select Case True
            Case IsDate(Target) And Target <= Now:: Couleur = Rouge: Texte = Blanc: Gras = True
            Case Target = "": Couleur = Blanc: Texte = Noir: Gras = False
            Case Target = "Annulé": Couleur = Rouge: Texte = Blanc: Gras = True
            Case Target = "NPR": Couleur = Rouge: Texte = Blanc: Gras = True
            Case Target = "RdV Fait": Couleur = Vert: Texte = Blanc: Gras = True
            Case Target = "RdV Fait Facturé": Couleur = Vert: Texte = Blanc: Gras = True
            Case Else: Couleur = Blanc: Texte = Noir: Gras = False
        End Select

        Target.Interior.Color = Couleur
        Target.Font.Color = Texte
        Target.Font.Bold = Gras
    End If
End Sub
 
Vote positif 0 Vote négatif
ou encore on en supprime un et un autre fra pour les deux
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [J2:J500]) Is Nothing Then
        Dim Couleur, Texte, Gras, Blanc, Noir, Rouge, Vert, Jaune
        Application.ScreenUpdating = False
        Blanc = vbWhite: Noir = vbBlack: Rouge = RGB(192, 0, 0): Vert = RGB(56, 87, 35): Jaune = RGB(255, 255, 204)

        Select Case True
            Case IsDate(Target) And Target <= Now:: Couleur = Rouge: Texte = Blanc: Gras = True
            Case Target = "": Couleur = Blanc: Texte = Noir: Gras = False
            Case Target = "Annulé": Couleur = Rouge: Texte = Blanc: Gras = True
            Case Target = "NPR": Couleur = Rouge: Texte = Blanc: Gras = True
            Case InStr(1, Target, "RdV Fait"): Couleur = Vert: Texte = Blanc: Gras = True
            Case Else: Couleur = Blanc: Texte = Noir: Gras = False
        End Select

        Target.Interior.Color = Couleur
        Target.Font.Color = Texte
        Target.Font.Bold = Gras
    End If
End Sub
 
Vote positif 0 Vote négatif
ou bien encore une petite reduction
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [J2:J500]) Is Nothing Then
        Dim Couleur, Texte, Gras, Blanc, Noir, Rouge, Vert, Jaune
        Application.ScreenUpdating = False
        Blanc = vbWhite: Noir = vbBlack: Rouge = RGB(192, 0, 0): Vert = RGB(56, 87, 35): Jaune = RGB(255, 255, 204)

        Select Case True
            Case (IsDate(Target) And Target <= Now) Or Target = "Annulé" Or Target = "NPR"
                Couleur = Rouge: Texte = Blanc: Gras = True
            Case InStr(1, Target, "RdV Fait"): Couleur = Vert: Texte = Blanc: Gras = True
            Case Else: Couleur = Blanc: Texte = Noir: Gras = False
        End Select

        Target.Interior.Color = Couleur
        Target.Font.Color = Texte
        Target.Font.Bold = Gras
    End If
End Sub
c'est bien le case true je trouve 😉
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Résolu(e)
XL 2016 Colorer cellules suivant condition saisie texte en VBA
Réponses
5
Affichages
81
Al1_44
A
D
  • Résolu(e)
Microsoft 365 MFC sur des cellules au format hh:mm:ss
Réponses
4
Affichages
148
Daffy02
D
L
  • Résolu(e)
Microsoft 365 Aide : Colorer une cellule en fonction de sa valeur
Réponses
2
Affichages
399
Leo98
L
S
  • Question Question
Microsoft 365 Colorer automatiquement des cellules en les sélectionnant
Réponses
5
Affichages
508
Jacky67
Jacky67
Gen Rose
  • Résolu(e)
XL 2019 MFC - Colorer les répétitions sauf le premier de la série
Réponses
4
Affichages
461
Gen Rose
Gen Rose
Usine à gaz
  • Résolu(e)
XL 2019 Ne pas utiliser les MFC
Réponses
5
Affichages
557
Usine à gaz
Usine à gaz
K
  • Question Question
XL 2019 VBA colorer les cellules et éliminer les cellules en rouge dans le calcul de plus proche valeur
Réponses
3
Affichages
383
KAMARY
K
vgendron
  • Question Question
XL 2010 Priorité sur MFC
Réponses
9
Affichages
915
dysorthographie
dysorthographie
LAETI-TOINOU
  • Question Question
Microsoft 365 Somme, moyenne et MFC sur plage de cellules variable
Réponses
4
Affichages
581
LAETI-TOINOU
LAETI-TOINOU
I
  • Question Question
XL 2016 Colorer cellules entre 2 dates et étendre la mise en forme et ajout de texte
Réponses
1
Affichages
535
Irina1009
I
B
  • Question Question
XL 2016 MFC - COMPARAISON ENTRE DEUX CELLULES - ECART
Réponses
3
Affichages
1 K
Victor21
Victor21
Usine à gaz
  • Résolu(e)
Microsoft 365 Vérification de ma formule
2
Réponses
16
Affichages
2 K
Usine à gaz
Usine à gaz
J
  • Question Question
XL 2019 MFC sur des fichiers auto générés
Réponses
12
Affichages
946
jui42
J
apicius46
  • Question Question
XL 2010 [résolu]MFC Suivant le texte en cellule colorer une des 3 cellules.
Réponses
2
Affichages
716
apicius46
apicius46
pilou010
  • Résolu(e)
XL 2013 MFC recherche de doublons dans 2 colonnes sans les cellules vides
Réponses
4
Affichages
747
Jocelyn
Jocelyn
L
  • Résolu(e)
XL 2013 Colorer cellules d'une colonne dont les "coordonnées" apparaissent dans d'autres
Réponses
2
Affichages
578
Leguyl
L
T
  • Question Question
Autres MFC faisant référence à deux cellules avec formule
Réponses
8
Affichages
1 K
sylvanu
sylvanu
W
  • Question Question
XL 2016 QUEL ALGORITHME UTILISE AVEC LA FONCTION SI AYANT DES CELLULES EN CHAINE DE CARACTERES
Réponses
1
Affichages
983
Dranreb
Dranreb
M
  • Résolu(e)
XL 2010 COLORER UNE PLAGE DE CELLULES EN FONCTION D'UN TEXTE
Réponses
14
Affichages
1 K
MAXTHOMSON
M
jeanmi
  • Question Question
XL 2010 Import image dans des cellules fusionnées, sans déformation de l'image.
Réponses
0
Affichages
958
jeanmi
jeanmi
Retour