Microsoft 365 Mise en forme ligne listview date dépassée

Dem8

XLDnaute Nouveau
Bonjour à tous,

N'étant qu'une débutante en VBA, je pique des bouts de codes dans les tutos et sur les forums, je les assemble et les adapte en fonction de mes besoins. Seulement, cette fois, je suis boquée et je ne sais pas où se situe mon erreur.

Dans mon fichier Excel, j'ai une base de données qui contient tous les échantillons stockés par mon entreprise.
Cette base de données est visible dans la listview d'un userform.

La 4ème colonne de cette listview contient la date de mise en stockage. La cinquième colonne affiche la date de fin de stockage. J'aimerais que, lorsqu'un échantillon a atteint sa date de fin de stockage, sa ligne se colore en rouge dans la listview.

Mon code fonctionne quand je mets la condition sur une colonne qui contient des chiffres, mais pas sur une colonne qui contient une date. Où me suis-je trompée ?
Est-ce que c'est au niveau du dd/mm/yyyy" ? Du Now ?



Private Sub Actualisation()

Dim item As ListItem
Dim derniereligne As Integer
Dim i As Integer
Dim couleur As Variant
Dim moncritere As Variant

ListView1.ListItems.Clear
derniereligne = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To derniereligne

'moncritere = Format(Feuil2.Cells(i, 9), "#0")

'Select Case moncritere
'Case Is < 2
'couleur = &H80FF&
'Case Is >= 2
'couleur = &HFF00&

moncritere = Format(Feuil2.Cells(i, 5), "dd/mm/yyyy")

Select Case moncritere

Case Is <= Now
couleur = &H80FF&

Case Is > Now
couleur = &HFF00&

End Select

Set item = ListView1.ListItems.Add(Text:=Feuil2.Cells(i, 1))

item.SubItems(1) = Feuil2.Cells(i, 2)
item.ListSubItems(1).ForeColor = couleur
item.SubItems(2) = Feuil2.Cells(i, 3)
item.ListSubItems(2).ForeColor = couleur
item.SubItems(3) = Feuil2.Cells(i, 4)
item.ListSubItems(3).ForeColor = couleur
item.SubItems(4) = Feuil2.Cells(i, 5)
item.ListSubItems(4).ForeColor = couleur
item.SubItems(5) = Feuil2.Cells(i, 6)
item.ListSubItems(5).ForeColor = couleur
item.SubItems(6) = Feuil2.Cells(i, 7)
item.ListSubItems(6).ForeColor = couleur
item.SubItems(7) = Feuil2.Cells(i, 8)
item.ListSubItems(7).ForeColor = couleur
item.SubItems(8) = Feuil2.Cells(i, 9)
item.ListSubItems(8).ForeColor = couleur
item.SubItems(9) = Feuil2.Cells(i, 10)
item.ListSubItems(9).ForeColor = couleur
item.SubItems(10) = Feuil2.Cells(i, 11)
item.ListSubItems(10).ForeColor = couleur
item.SubItems(11) = Feuil2.Cells(i, 12)
item.ListSubItems(11).ForeColor = couleur

Next i

End Sub

N'hésitez pas à me demander si vous avez besoin de plus d'éléments et merci beaucoup d'avance pour votre aide.
 
Solution
Re dem8
une adaptation de ta procédure (ta procédure qui fonctionne)
On pourrait ajouter un test sur la Validité de la date récupérée dans "DateCompare"
VB:
Private Sub Actualisation()
Dim Today As Long
    Dim DateCompare As Long
    Dim Col As Byte
    Dim LstVi As MSComctlLib.ListItem
    Dim LstVSi As MSComctlLib.ListSubItem
    Dim derniereligne As Integer
    Dim i As Integer
    Dim couleur As Variant
    Dim moncritere As Variant
  Today = Date 'on récupére la date du jour au format Long
Tbl_BDD = Range("t_BDD").ListObject.DataBodyRange.Value 'on récupére les données de la plage de Données du Tableau "t_BDD"
    With UserForm2 'avec le userform
     With .ListView1 'avec la Listview
          .ListItems.clear 'on...

patricktoulon

XLDnaute Barbatruc
Bonjour
avec un fichier ce serait plus facile de t'aider
cela dit j'entrevois un problème de non compréhension du type de donnée
une variable qui recois format(quelque chose,"leformat") c'est du string
alors quand tu teste < ou > que dans ton select case j'imagine que ca doit planter
ou faire n'importe quoi

si tu dois comparer des dates n'utilise jamais format ou alors reconverti en date
 

Dem8

XLDnaute Nouveau
Bonjour à tous les deux et merci pour vos réactions,

J'ai enlevé quelques données de mon fichier pour pouvoir vous le partager, le voici donc :)

Justement, dans mon code, j'ai remplacé "moncritere = Format(Feuil2.Cells(i, 5), "dd/mm/yyyy")" par "moncritere = Feuil2.Cells(i, 5)" et ça semble fonctionner mais je ne sais pas si cette manière est la bonne et si elle n'occasionnera pas d'autres erreurs par la suite...
 

Pièces jointes

  • Storage.xlsm
    86.5 KB · Affichages: 11

ChTi160

XLDnaute Barbatruc
Re dem8
une adaptation de ta procédure (ta procédure qui fonctionne)
On pourrait ajouter un test sur la Validité de la date récupérée dans "DateCompare"
VB:
Private Sub Actualisation()
Dim Today As Long
    Dim DateCompare As Long
    Dim Col As Byte
    Dim LstVi As MSComctlLib.ListItem
    Dim LstVSi As MSComctlLib.ListSubItem
    Dim derniereligne As Integer
    Dim i As Integer
    Dim couleur As Variant
    Dim moncritere As Variant
  Today = Date 'on récupére la date du jour au format Long
Tbl_BDD = Range("t_BDD").ListObject.DataBodyRange.Value 'on récupére les données de la plage de Données du Tableau "t_BDD"
    With UserForm2 'avec le userform
     With .ListView1 'avec la Listview
          .ListItems.clear 'on efface la Listview
    For lgn = 1 To UBound(Tbl_BDD, 1) 'pour chaque lignes du tableau
DateCompare = DateValue(Tbl_BDD(lgn, 5)) 'on récupère la date en colonne 5 au Format Long
  couleur = IIf(DateCompare <= Today, RGB(255, 0, 0), RGB(0, 0, 0)) 'on récupére la couleur de la Ligne selon la valeur de la date
 
    Set LstVi = .ListItems.Add(, , Tbl_BDD(lgn, 1)) 'On récupére on crée une Ligne via la Variable LstVi "ListItem"
With LstVi 'avec cette Ligne ainsi créee
  For Col = 2 To UBound(Tbl_BDD, 2) 'pour chaque colonne du tableau
   Set LstVSi = .ListSubItems.Add(, , Tbl_BDD(lgn, Col)) 'on ajoute un element ,une colonne sur la Ligne "LstVi" via la variable "LstVSi"
        With LstVSi 'avec celle colonne
          .ForeColor = couleur 'on la colore
        End With
   Next Col
   End With
  Next lgn
 End With
End With
End Sub
remarque sans prétention !
Eviter d'employer comme nom de variable des éléments du vocabulaire de programmation ex : "Item"
Bonne fin de Soirée
Jean marie
 
Dernière édition:

Discussions similaires