Date en couleur dans fichier excel VBA [Résolu]

Signaler
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
-
Messages postés
27
Date d'inscription
mardi 10 avril 2007
Statut
Membre
Dernière intervention
11 mai 2007
-
Bonjour à tous,

Voici mon problème,

Dans un fichier excel, dans les cellules (D27:D73) qui contients des dates ex:(10 avril 2007), je voudrais que si la date inscrit des ses céllules correspont à la date d'aujourd'hui moins 2 à 5 jours, qu'il le met en rouge avec fond jaune et si il date d'aujourd'hui moins 6 jours et plus, qu'il le met en jaune avec fond rouge.

Comment faire s.v.p

16 réponses

Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
Je viens de relire et de remarquer que tu as dis (en tout premier) :
et si il date d'aujourd'hui moins 6 jours et plus, qu'il le met en jaune avec fond rouge.

J'ai omis de le gérer mais il suffit de faire sur le même principe, voici donc les corrections (surtout dans la 1ère partie, avec gestion Couleur de fond / Couleur de la Police) :

Private Sub Colorize(ByVal MyRedPlage As Range, ByVal MyYellowPlage As Range)
    Dim MyCell As Range
    
Application.ScreenUpdating =  False

' *** 1ere partie, les dates comprises entre la date-2 et la date-5

For Each MyCell In MyRedPlage
    If MyCell.Value < (Date - 1) And MyCell.Value > (Date - 6) Then
       With MyCell
            .Interior.ColorIndex = 6
            .Font.ColorIndex = 3
        End With
    ElseIf MyCell.Value < (Date - 6) Then
       With MyCell
            .Interior.ColorIndex = 3
            .Font.ColorIndex = 6
        End With
    End If
Next MyCell

' *** 2nde partie, les dates supérieures à la date & 1h du matin
    Dim MyDate As Date
    
MyDate = Date & Space(1) & "00:00:59"
Range("F:F").Interior.ColorIndex = 3

For Each MyCell In MyYellowPlage
    If MyCell.Value > MyDate And IsDate(MyCell) Then MyCell.Interior.ColorIndex = 6
Next MyCell

Application.ScreenUpdating = True
    
Set MyCell = Nothing
End Sub

Sub Exemple()
    Call Colorize(Range("D27:D73"), Range("F:F"))
End Sub

~ <small> Mortalino ~ Colorisation automatique </small>

@++

<hr width ="100%" size="2" />
  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
  
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
Presque ça, regarde en rouge :

Private Sub Colorize(ByVal MyRedPlage As Range, ByVal MyYellowPlage As Range)
    Dim MyCell As Range
   
Application.ScreenUpdating = False

' *** 1ere partie, les dates comprises entre la date-2 et la date-5

For Each MyCell In MyRedPlage
    If MyCell.Value < (Date - 1) And MyCell.Value > (Date - 6) Then MyCell.Interior.ColorIndex = 3
Next MyCell

For Each MyCell In <strike>MyRedPlage</strike>MyYellowPlage
    If MyCell.Value < (Date - 7) And MyCell.Value > (Date - 300) Then MyCell.Interior.ColorIndex = 4
Next MyCell

Application.ScreenUpdating = True
   
Set MyCell = Nothing
End Sub

<hr width="100%" size="2" />
Private Sub Colorize2(ByVal MyRedPlage As Range, ByVal MyYellowPlage As Range)
    Dim MyCell As Range
   
Application.ScreenUpdating = False

For Each MyCell In MyRedPlage
    If MyCell.Value < (Date - 1) And MyCell.Value > (Date - 6) Then MyCell.Interior.ColorIndex = 3
Next MyCell

For Each MyCell In <strike>MyRedPlage</strike>MyYellowPlage
    If MyCell.Value < (Range("G1")) Then MyCell.Interior.ColorIndex = 4
Next MyCell
Application.ScreenUpdating = True
 Set MyCell = Nothing
End Sub

@++

<hr width="100%" size="2" />
  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
  
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
Salut,

voici un exemple, les dates comprises dans l'interval seront en fond rouge :

Private Sub Colorize(ByVal MyPlage As Range)
    Dim MyCell As Range
    
For Each MyCell In MyPlage
    If MyCell.Value < (Date - 1) And MyCell.Value > (Date - 6) Then MyCell.Interior.ColorIndex = 3
Next MyCell
    
End Sub

Sub Exemple()
    Call Colorize(Range("D27:D73"))
End Sub

~ <small> Mortalino ~ Colorisation automatique </small>

@++

<hr width ="100%" size="2" />
  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
  
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
Merci pour ta réponse.

¨ca fonctionne très bien mais si dans la colonne F, je dois mettre en couleur tous rouge  avec fond jaune tous ce qui est plus élevé que 1:00:00 AM.  Comment ajouter à la formule que tu m'as donné?
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
Voici l'adaptation :

Private Sub Colorize(ByVal MyRedPlage As Range, ByVal MyYellowPlage As Range)
    Dim MyCell As Range
    
Application.ScreenUpdating = False

' *** 1ere partie, les dates comprises entre la date-2 et la date-5

For Each MyCell In MyRedPlage
    If MyCell.Value < (Date - 1) And MyCell.Value > (Date - 6) Then MyCell.Interior.ColorIndex = 3
Next MyCell

' *** 2nde partie, les dates supérieures à la date & 1h du matin
    Dim MyDate As Date
    
MyDate = Date & Space(1) & "00:00:59"

For Each MyCell In MyYellowPlage
    If MyCell.Value > MyDate And IsDate(MyCell) Then MyCell.Interior.ColorIndex = 6
Next MyCell

Application.ScreenUpdating = True
    
Set MyCell = Nothing
End Sub

Sub Exemple()
    Call Colorize(Range("D27:D73"), Range("F:F"))
End Sub

~ <small>Mortalino ~ Colorisation automatique

</small>@++

<hr width="100%" size="2" />
  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
  
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
Arf, j'ai oublié de colorier F:F en rouge, sous
MyDate = Date & Space(1) & "00:00:59"

place
Range("F:F").Interior.ColorIndex = 3

@++

<hr width="100%" size="2" />
  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
  
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
Désolé, je le place ou exactement? 

MyDate =  Date & Space(1) & "00:00:59"

Range("F:F").Interior.ColorIndex = 3


For Each MyCell In MyYellowPlage
    If MyCell.Value > MyDate And IsDate(MyCell) Then MyCell.Interior.ColorIndex = 6
Next MyCell

Application.ScreenUpdating = True
    
Set MyCell = Nothing
End Sub

Sub Exemple()
    Call Colorize(Range("D27:D73"), Range("F:F"))
End Sub
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
Dans un Module, place ce code :

Private Sub Colorize(ByVal MyRedPlage As Range, ByVal MyYellowPlage As Range)
    Dim MyCell As Range
    
Application.ScreenUpdating =  False

' *** 1ere partie, les dates comprises entre la date-2 et la date-5

For Each MyCell In MyRedPlage
    If MyCell.Value < (Date - 1) And MyCell.Value > (Date - 6) Then MyCell.Interior.ColorIndex = 3
Next MyCell

' *** 2nde partie, les dates supérieures à la date & 1h du matin
    Dim MyDate As Date
    
MyDate = Date & Space(1) & "00:00:59"

For Each MyCell In MyYellowPlage
    If MyCell.Value > MyDate And IsDate(MyCell) Then MyCell.Interior.ColorIndex = 6
Next MyCell

Application.ScreenUpdating = True
    
Set MyCell = Nothing
End Sub

Sub Exemple()
    Call Colorize(Range("D27:D73"), Range("F:F"))
End Sub




Ensuite, quand tu en as besoin, par code, fais un Call Exemple

Sinon, avec la barre d'outil suivante :

Clique non pas sur le carré rouge, mais le premier icone (flêche verte).
Tu auras la liste des Sub de type public, clique sur Exemple et le tour est joué.

Les deux dernières possibilités : placer un CommadButton sur la feuille, qui fait un Call Exemple

lors du clique, ou créer un onglet supplémentaire (comme Fichier, Edition, etc..)

@++





<hr width ="100%" size="2" />

  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
  
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
Merci beaucoup ça m'aide beaucoup.

Sans compter les couleur dans le code, J,ai modifié légerement.
<hr size="2" width="100%" />
Private Sub Colorize(ByVal MyRedPlage As Range, ByVal MyYellowPlage As Range)
    Dim MyCell As Range
   
Application.ScreenUpdating = False

' *** 1ere partie, les dates comprises entre la date-2 et la date-5

For Each MyCell In MyRedPlage
    If MyCell.Value < (Date - 1) And MyCell.Value > (Date - 6) Then MyCell.Interior.ColorIndex = 3
Next MyCell

For Each MyCell In MyRedPlage
    If MyCell.Value < (Date - 7) And MyCell.Value > (Date - 300) Then MyCell.Interior.ColorIndex = 4
Next MyCell

Application.ScreenUpdating = True
   
Set MyCell = Nothing
End Sub

<hr size="2" width="100%" />
Private Sub Colorize2(ByVal MyRedPlage As Range, ByVal MyYellowPlage As Range)
    Dim MyCell As Range
   
Application.ScreenUpdating = False

For Each MyCell In MyRedPlage
    If MyCell.Value < (Date - 1) And MyCell.Value > (Date - 6) Then MyCell.Interior.ColorIndex = 3
Next MyCell

For Each MyCell In MyRedPlage
    If MyCell.Value < (Range("G1")) Then MyCell.Interior.ColorIndex = 4
Next MyCell
Application.ScreenUpdating = True
 Set MyCell = Nothing
End Sub

<hr size="2" width="100%" />
Private Sub CommandButton1_Click()
Call Colorize(Range("F1:F20"), Range("G1:G20"))
Call Colorize2(Range("C1:C20"), Range("D1:D20"))
End Sub
<hr size="2" width="100%" />
Je test et je te reviens là dessus. 
Messages postés
797
Date d'inscription
mardi 7 juin 2005
Statut
Membre
Dernière intervention
23 février 2011
5
Soit dit entre nous, vous aimez vous compliquer hein ^^
Ce que tu essayes d'obtenir s'appelle dans Excel une Mise en forme conditionnelle.


 


Ttu vas sur ta cellule D27 et tu fais Menu Format\Mise en forme conditionnelle.
Tu colles 2 conditions :
1ère : =AUJOURDHUI()-$D27>6 et tu choisis une police jaune, un motif rouge
2ème : =AUJOURDHUI()-$D27>2 et tu choisis une police rouge, un motif jaune
(dans cet ordre si tu veux que ça fonctionne, Excel interprète la première condition et si elle est remplie, ignore les autres).
Tu n'as plus qu'à copier la mise en forme sur toutes les cellules de ta plage de données avec l'outil pinceau et hop, tes couleurs s'afficheront en temps réel.

Pas une ligne de code, du temps réel, 20 secondes de travail.
Elle n'est pas belle la vie ?
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
18
Tu pourrais utiliser la mise en forme conditionnelle.

Place-toi en D27
Menu Format / Mise en forme conditionnelle

Tu commences par choisir "La formule est" dans la première boîte et tu inscris la formule suivante dans la 2e boîte, puis tu cliques le bouton Format et tu choisis la couleur de texte et de fond (texte jaune sur fond rouge)
=ET(CNUM(AUJOURDHUI())-CNUM(D27)>1;CNUM(AUJOURDHUI())-CNUM(D27)<6)

Ensuite tu cliques "Ajouter >>" pour une deuxième condition
Tu choisis encore "La formule est" et tu copies cette autre formule
=CNUM(AUJOURDHUI())-CNUM(D27)>5

et tu choisi encore une couleur de texte et de fond (texte rouge sur fond jaune)

Il ne te reste qu'à utiliser le petit pinceau pour copier ce format aux autres cellules jusqu'en D73

MPi
Messages postés
797
Date d'inscription
mardi 7 juin 2005
Statut
Membre
Dernière intervention
23 février 2011
5
Ouh le vilain copieur MPi ... Et en plus, c'est plus compliqué, moi je dis : nanananère heu

Molenn
Messages postés
360
Date d'inscription
dimanche 3 décembre 2006
Statut
Membre
Dernière intervention
3 janvier 2012
3
Et Bien merci pour toute vos réponses, j'ai choisis l'option de mortalinos qui fonctionne super.

Mais encore une fois merci à tous.
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
18
Molenn, je n'avais pas vu ton Post... juré...sûr,sûr...
Et tu peux bien me tirer la langue  ¦¬)
(Je déteste les dates, je les hais...)
Il me semble toutefois avoir essayer une formule sans le CNum et ça ne rendait pas  (???)

MPi
Messages postés
27
Date d'inscription
mardi 10 avril 2007
Statut
Membre
Dernière intervention
11 mai 2007




Messages postés
27
Date d'inscription
mardi 10 avril 2007
Statut
Membre
Dernière intervention
11 mai 2007

Bonjour à tous.

Voici mon petit programme, pas vraiment parfait car j'ai encore quelques questions auxquelles je n'ai pas encore de réponse...
Parmis elles, celle-ci:
   Comment activer automatiquement ma macro dès la sélection d'une cellule de la colonne F, par exemple?

Merci d'avance.

P.S. Si vous avez des remarques, n'hésitez pas.

Sub ContrôleSaisie()
Dim reponse As Integer
Dim message As String
message = "Il faut d'abord saisir le nombre d'heures réalisées?"
Dim devis  As Variant


devis = Val(InputBox("Indiquez le N° du Devis en cours: ", "N° du Devis"))


'A ce niveau, pour la commande inputbox, existe-t-il des valeur pour la touche "annuler" ou la croix qui permettrait de quitter la procédure Sub ControleSaisie()... End Sub; ceci afin d'éviter l'apparition du message d'erreur avec la touche débogage

validation = MsgBox("Il s'agit du devis N° " & devis & ".   Est-ce correct?", _
                    vbYesNo + vbInformation, "Validation")


     If validation = 6 Then
     Range("IV1").Value = devis


   ElseIf validation = 7 Then
    While validation <> 6
devis = InputBox("Indiquez le N° du Devis en cours: ", "N° du Devis")


validation = MsgBox("le N° du devis est:" & devis & ". Est-ce correct?", _
                    vbYesNo + vbInformation, "Validation")
    Wend
  
End If


If Range("F" & devis + 6).Select = True Then


    While Range("V" & devis + 6).Value = ""
    Sheets("Feuil2").Range("F" & devis + 6).ClearContents  
    reponse = MsgBox(message, vbOKOnly + vbCritical, "Attention")
    If reponse = 1 Then
        Exit Sub
    End If


    Wend
End If


End Sub