Excel: Faire varier les couleur d'une cellule

Fermé
Boulot P. - 13 févr. 2014 à 17:13
lewis34 Messages postés 2557 Date d'inscription samedi 21 juillet 2007 Statut Membre Dernière intervention 30 mai 2015 - 13 févr. 2014 à 18:27
Bonjour,

J'ai créé un fichier de suivi factures clients
Il y a une colonne Date de facture et une colonne Date d'échéance de la facture.
Je voudrais savoir comment faire (quelle application), sur Excel, pour que 15 jours avant le date d'échéance la cellule soit de couleur Orange et à la date d'échéance voir plus la couleur de la cellule soit Rouge, de façon automatique
Je vous remercie d'avance
A voir également:

1 réponse

lewis34 Messages postés 2557 Date d'inscription samedi 21 juillet 2007 Statut Membre Dernière intervention 30 mai 2015 352
13 févr. 2014 à 18:27
bonjour, voici un petit bout de code que j'ai fait en deux deux, evuidemment il sera a adapter a ton cas

dans ta feuille excel tu ouvre visual basic et dans ton classeur tu lui ciolle ce code dans l'evenement open comme ca a chaque fois que tu va ouvri ton classeur la comparaison des dates de factures contenue dabs ta feuille va se faire avec celle d'aujourd'hui.



Private Sub Workbook_Open()
'je recupere le nbr de ligne non vide de la feuille
Dim DernLigne As Long
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Dim cel As Range
Dim lig_n As Long, col_n As Long
Dim FL1 As Worksheet, NoCol As Long
Dim date_facture As Date
Dim NoLig As Long, Var As Variant
Dim date_dif As Long


Dim datedujour As Date
datedujour = Date

Set FL1 = Worksheets("Feuil1") ' la feuille qui contient tes données

NoCol = 4 'lecture de la colonne 4 celle qui contient la date
'evidemment tu adapte a ton cas

'parcours du fichier pour comparer les dates
For NoLig = 2 To DernLigne
date_facture = FL1.Cells(NoLig, NoCol)
date_dif = DateDiff("d", datedujour, date_facture)
If date_dif > 0 Then
' je prends que les dates supérieur a aujourd'hui

If date_dif = 0 Then
'echeance aujourdui
'pour les couleurs regarde ce lien
' http://iblogbox.com/devtools/color/

FL1.Cells(NoLig, NoCol).Interior.Color = RGB(255, 0, 0)
ElseIf date_dif > 0 And date_dif < 15 Then
FL1.Cells(NoLig, NoCol).Interior.Color = RGB(255, 224, 32)
ElseIf date_dif >= 15 Then
FL1.Cells(NoLig, NoCol).Interior.Color = RGB(128, 255, 0)
Else
FL1.Cells(NoLig, NoCol).Interior.Color = RGB(160, 255, 255) 'par défaut
End If

Else
'les dates passées
FL1.Cells(NoLig, NoCol).Interior.Color = RGB(192, 192, 192)

End If
'MsgBox (datedujour & " / " & date_facture & " / " & date_dif)

Next NoLig

Set FL1 = Nothing

End Sub


voila a tester mais cela devaris etre fonctionnel comme ça
0