Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Usine à gaz

XLDnaute Barbatruc
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)

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

  • 0 MFC Fond police_test.xlsm
    228.2 KB · Affichages: 2
Trier par date Trier par votes

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

  • 0 MFC Fond police_test (1).xlsm
    221.5 KB · Affichages: 4
Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc
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

patricktoulon

XLDnaute Barbatruc
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

patricktoulon

XLDnaute Barbatruc
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

patricktoulon

XLDnaute Barbatruc
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
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

L
  • Résolu(e)
Microsoft 365 Aide : Colorer une cellule en fonction de sa valeur
Réponses
2
Affichages
316
Leo98
L
S
  • Question
Microsoft 365 Colorer automatiquement des cellules en les sélectionnant
Réponses
5
Affichages
427
Jacky67
T
  • Résolu(e)
XL 2013 Harmoniser valeur de cellules selon 2 variables
Réponses
4
Affichages
128
Thomas75
T
  • Résolu(e)
XL 2019 MFC - Colorer les répétitions sauf le premier de la série
Réponses
4
Affichages
442
Gen Rose
  • Résolu(e)
XL 2019 Ne pas utiliser les MFC
Réponses
5
Affichages
531
Usine à gaz
K
  • Question
XL 2019 VBA colorer les cellules et éliminer les cellules en rouge dans le calcul de plus proche valeur
Réponses
3
Affichages
352
KAMARY
K
  • Question
XL 2010 Priorité sur MFC
Réponses
9
Affichages
868
dysorthographie
M
  • Question
Microsoft 365 Pb de formules qui se modifient dans des cellules verrouillées
Réponses
14
Affichages
571
TooFatBoy
C
  • Question
XL 2021 Cellules qui ne s'effacent pas sur formulaire et renvoi de valeurs du formulaire
Réponses
1
Affichages
345
gbinforme
G
W
  • Résolu(e)
XL 2016 Ordonner une cellule ou un pavé de cellules contenant des chr(10)
Réponses
5
Affichages
521
Webperegrino
W
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…