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

D

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
ChTi160
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...
Trier par date Trier par votes
patricktoulon

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
 
Vote positif 0 Vote négatif
D

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: 31
Vote positif 0 Vote négatif
ChTi160

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:
Vote positif 0 Vote négatif
Solution
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour et bienvenue TCHIS

Je ne suis pas chez moi (pour une semaine)et je n'ai pas mon Ordi !
Donc faudra être patient , à moins que tu ne trouves ton bonheur sur le forum.
Faudra que tu mettes un fichier anonymisé et des explications de ce que tu as et ce que tu veux.
Bonne fin de journée
Jean marie
PS: je n'avais pas ton Fil
Le lien
Apparemment c'est urgent ! Donc c'est râpé...
 
Dernière édition:
Vote positif 0 Vote négatif
T

TCHIS

XLDnaute Occasionnel
Bonjour ChiTi160

J'attendrai les une semaine toutefois je vais chercher encore et encore comme ça je pourrai peut être avancé même si je suis convaincu que votre fichier à vous règlerai mon problème en grande partie.

En gros je me trouve sur ma ListView que j'ai initialisé et sur laquelle je souhaiterai appliqué des filtres.
*****Les Filtres en questions je souhaiterai qu'il en est sur plusieurs critères précisément 8 critères *****:
  1. Site
  2. Métier
  3. Fréquence
  4. Etat
  5. Niveau de validité
  6. Année
  7. Mois
  8. Semaine
Aussi si possible avoir le nombre d'enregistrement qui s'adapterait aux filtres quand ceux-ci sont actifs.
En plus de cela si possible lorsqu'on applique les filtres ceux -ci n'affecte pas la tables.
En fichier joint vous avez le fichier Excel sur lequel je travail
Important de savoir que la Frame1 en dessous et est destinée à remplir la listview donc le mieux serait que le filtre doit se faire indépendamment de cette frame1 mais juste sur la ListView
 

Pièces jointes

  • TCHIS.xlsm
    66.6 KB · Affichages: 8
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
1 K
Phil69970
Phil69970
Wayat
  • Question
XL 2019 Date et mise en forme conditionnelle
Réponses
5
Affichages
530
fanfan38
fanfan38
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
1 K
Dranreb
Dranreb
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
934
Nicolas JACQUIN
Nicolas JACQUIN
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
322
souhaib ad
S
N
  • Question
Microsoft 365 Recherche dans un tableau structuré à partir d'une TextBox
Réponses
11
Affichages
273
NONO14
N
D
  • Question
XL 2016 VBA format date
2
Réponses
17
Affichages
1 K
vgendron
vgendron
C
  • Question
XL 2021 Positionnement sur une cellule en fonction de la date, du jour et de l'heure
Réponses
2
Affichages
405
clausen
C
I
  • Résolu(e)
XL 2019 Supprimer une ligne d'une base de données une fois qu'elle est transférée sur une autre feuille
Réponses
8
Affichages
576
Isabellisa
I
A
  • Résolu(e)
XL 2016 Alimentation d'un fichier selon données sélectionnées via une ComboBox
Réponses
3
Affichages
506
Aldonanou
A

Membres actuellement en ligne

2 membres et 45 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 727
Messages
2 112 264
Membres
111 478
dernier inscrit
Excel_INFO