Macro changement couleur des dates passées

**Walt51** · 24/04/2014, 14h52

Bonjour,

J'ai fais une macro pour changer la couleur de toutes les dates d'une colonne d'une feuille Excel, si celles-ci sont passée.
PB, seulement certaines dates change automatiquement
Mon code marche qu'a moitié, pourquoi?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Private Sub Worksheet_Activate()    'Coloration des dates de délai passé
 
Dim DateJour As Variant
DateJour = Now()
Dim Valeur As Integer
 
Valeur = Sheets("HISTORIQUE DES COMMANDES").Range("D" & Rows.Count).End(xlUp).Row
 
For i = 1 To Valeur
 
    If Sheets("HISTORIQUE DES COMMANDES").Range("D" & i).Value < DateJour Then
 
        Sheets("HISTORIQUE DES COMMANDES").Range("D" & i).Font.ColorIndex = 3
        Sheets("HISTORIQUE DES COMMANDES").Range("D" & i).Font.Bold = True
 
    Else
 
    End If
 
 
    If Sheets("HISTORIQUE DES COMMANDES").Range("D" & i).Value > DateJour Then
 
        Sheets("HISTORIQUE DES COMMANDES").Range("D" & i).Font.ColorIndex = 0
        Sheets("HISTORIQUE DES COMMANDES").Range("D" & i).Font.Bold = False
 
 
    End If
 
Next i
 
End Sub

**lucasgaetan** · 24/04/2014, 16h24

Bonjour Walt51,

j'ai tester ton code et il fonctionne très bien.
Cependant, il ne traite que la colonne "D" de le feuille "HISTORIQUE DES COMMANDES"

A+

**Walt51** · 24/04/2014, 16h35

Envoyé par lucasgaetan

Bonjour Walt51,

j'ai tester ton code et il fonctionne très bien.

Cependant, il ne traite que la colonne "D" de le feuille "HISTORIQUE DES COMMANDES"

A+

Suis ravi de savoir qu'il marche très bien sur ton poste, car en effet, je ne demande que la colonne "D"
PB=> Certaines dates passée ne sont pas coloriées sur ma feuille
Pourquoi?

**lucasgaetan** · 24/04/2014, 16h56

Le problème est peut être que tu compares des dates et des string (ou autres)

tu peux mettre un contrôle au début de ta procédure:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Worksheet_Activate()    'Coloration des dates de délai passé
Dim DateJour As Variant
Dim Valeur As Long
Dim i As Long
 
DateJour = Now()
Valeur = Sheets("Feuil1").Range("E" & Rows.Count).End(xlUp).Row
 
    For i = 1 To Valeur
        If IsDate(Sheets("Feuil1").Range("E" & i).Value) = False Then
            Sheets("Feuil1").Range("E" & i).Font.ColorIndex = 5
            Sheets("Feuil1").Range("E" & i).Font.Bold = True
        ElseIf Sheets("Feuil1").Range("E" & i).Value < DateJour Then
            Sheets("Feuil1").Range("E" & i).Font.ColorIndex = 3
            Sheets("Feuil1").Range("E" & i).Font.Bold = True
        ElseIf Sheets("Feuil1").Range("E" & i).Value > DateJour Then
            Sheets("Feuil1").Range("E" & i).Font.ColorIndex = 0
            Sheets("Feuil1").Range("E" & i).Font.Bold = False
        End If
    Next i
 
End Sub

Les cellules non dates passent en bleu

**lucasgaetan** · 24/04/2014, 17h07

Sinon tu as la fonction mise en forme conditionnelle:

Tu sélectionnes la colonne D
dans Accueil/Style/Mise en forme conditionnelle/Règle de mise en surbrillance des cellules/Supérieur à

tu rentre cette formule:
=AUJOURDHUI()

tiens nous au jus

**EJO64** · 24/04/2014, 17h09

Bonjour,

la même procédure traitée avec un select case.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub Worksheet_Activate()
 
' la plage à traiter
For Each X In Sheets("HISTORIQUE DES COMMANDES").Range("D1", "D" & Sheets("HISTORIQUE DES COMMANDES").UsedRange.Rows.Count)
 
 
 ' test sur la valeur est de type date ?
 
    If IsDate(X.Value) Then
 
        ' conversion et test
        Select Case CDate(X.Value)
 
                    ' plus petit que maintenant  -> rouge gras
                    Case Is < Now()
 
                        With X.Font
                            .ColorIndex = 3
                            .Bold = True
                        End With
 
                    ' en noir normal
                   Case Is > Now()
 
                        With X.Font
                            .ColorIndex = 0
                            .Bold = False
                        End With
                ' en réserve par exemple pour date = aujourdh'hui
                Case Else
      End Select
   End If
 
Next
 
 
End Sub

**Walt51** · 29/04/2014, 11h26

Envoyé par EJO64

Bonjour,

la même procédure traitée avec un select case.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub Worksheet_Activate()
 
' la plage à traiter
For Each X In Sheets("HISTORIQUE DES COMMANDES").Range("D1", "D" & Sheets("HISTORIQUE DES COMMANDES").UsedRange.Rows.Count)
 
 
 ' test sur la valeur est de type date ?
 
    If IsDate(X.Value) Then
 
        ' conversion et test
        Select Case CDate(X.Value)
 
                    ' plus petit que maintenant  -> rouge gras
                    Case Is < Now()
 
                        With X.Font
                            .ColorIndex = 3
                            .Bold = True
                        End With
 
                    ' en noir normal
                   Case Is > Now()
 
                        With X.Font
                            .ColorIndex = 0
                            .Bold = False
                        End With
                ' en réserve par exemple pour date = aujourdh'hui
                Case Else
      End Select
   End If
 
Next
 
 
End Sub

Merci, grâce à ce code tous mes délais sont bien traités.
J'aimerai à présent ajouter des conditions en fonction de "L'état de la commande" colonne "O":

Colorié en rouge Si date passée ET : "Commande envoyée par e-mail" ou "Commande envoyée par fax" ou "Commande annulée" ou "Commande passée sur le site"
Ou en d'autre terme, ne pas colorié si "Matériel reçu..."

Comment dois-je m'y prendre?

Merci

**EJO64** · 05/05/2014, 13h08

Bonjour,

Il faut faire un test en utilisant le déplacement (Offset)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
' la plage à traiter
For Each x In Sheets("HISTORIQUE DES COMMANDES").Range("D1", "D" & Sheets("HISTORIQUE DES COMMANDES").UsedRange.Rows.Count)
 
 
 ' test sur la valeur est de type date ?
 
    If IsDate(x.Value) Then
 
        
       

        ' conversion et test
        Select Case CDate(x.Value)
 
                    ' plus petit que maintenant  -> rouge gras
                    Case Is < Now()
                            
                        ' Offset (ligne , colonne)  -> dans le cas de la colonne O, si la valeur à tester est "Reçu"
                        If x.Offset(0, 11).Value <> "Reçu" Then
 
                                With x.Font
                                    .ColorIndex = 3
                                    .Bold = True
                                End With
                                
                         End If
 
                    ' en noir normal
                   Case Is > Now()
 
                        With x.Font
                            .ColorIndex = 0
                            .Bold = False
                        End With
                ' en réserve par exemple pour date = aujourdh'hui
                Case Else
      End Select
   End If
 
Next

**Walt51** · 02/06/2014, 17h59

Envoyé par EJO64

Bonjour,

Il faut faire un test en utilisant le déplacement (Offset)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
' la plage à traiter
For Each x In Sheets("HISTORIQUE DES COMMANDES").Range("D1", "D" & Sheets("HISTORIQUE DES COMMANDES").UsedRange.Rows.Count)
 
 
 ' test sur la valeur est de type date ?
 
    If IsDate(x.Value) Then
 
        
       

        ' conversion et test
        Select Case CDate(x.Value)
 
                    ' plus petit que maintenant  -> rouge gras
                    Case Is < Now()
                            
                        ' Offset (ligne , colonne)  -> dans le cas de la colonne O, si la valeur à tester est "Reçu"
                        If x.Offset(0, 11).Value <> "Reçu" Then
 
                                With x.Font
                                    .ColorIndex = 3
                                    .Bold = True
                                End With
                                
                         End If
 
                    ' en noir normal
                   Case Is > Now()
 
                        With x.Font
                            .ColorIndex = 0
                            .Bold = False
                        End With
                ' en réserve par exemple pour date = aujourdh'hui
                Case Else
      End Select
   End If
 
Next

Ca ne marche pas.
La colonne "O" , ça devrait être "(0, 15)" non?
J'ai essayé aussi avec 15, mais sans succès.

Macro changement couleur des dates passées

Excel

Discussions similaires

Partager

Partager