Date en couleur dans fichier excel VBARésolu

Question

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

mortalino · Accepted Answer

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 ~ Mortalino ~ Colorisation automatique @++

--Mortalino-- Le mystérieux chevalier, ~Provençal, le Gaulois~

mortalino · Answer

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 ~ Mortalino ~ Colorisation automatique @++

--Mortalino-- Le mystérieux chevalier, ~Provençal, le Gaulois~

avyrex1926 · Answer

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é?

mortalino · Answer

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 ~ Mortalino ~ Colorisation automatique @++

--Mortalino-- Le mystérieux chevalier, ~Provençal, le Gaulois~

mortalino · Answer

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~

avyrex1926 · Answer

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

mortalino · Answer

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..) @++

--Mortalino-- Le mystérieux chevalier, ~Provençal, le Gaulois~

avyrex1926 · Answer

Merci beaucoup ça m'aide beaucoup. Sans compter les couleur dans le code, J,ai modifié légerement.

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

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

Private Sub CommandButton1_Click() Call Colorize(Range("F1:F20"), Range("G1:G20")) Call Colorize2(Range("C1:C20"), Range("D1:D20")) End Sub

Je test et je te reviens là dessus.

mortalino · Answer

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 ~~MyRedPlage~~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

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~~MyYellowPlage If MyCell.Value < (Range("G1")) Then MyCell.Interior.ColorIndex = 4 Next MyCell Application.ScreenUpdating = True Set MyCell = Nothing End Sub @++

--Mortalino-- Le mystérieux chevalier, ~Provençal, le Gaulois~

Molenn · Answer

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 ?

cs_MPi · Answer

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

Molenn · Answer

Ouh le vilain copieur MPi ... Et en plus, c'est plus compliqué, moi je dis : nanananère heu 

Molenn

avyrex1926 · Answer

Et Bien merci pour toute vos réponses, j'ai choisis l'option de mortalinos qui fonctionne super.

Mais encore une fois merci à tous.

cs_MPi · Answer

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

fikriiii · Answer

fikriiii · Answer

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

Date en couleur dans fichier excel VBA

16 réponses

Votre réponse

Discussions similaires