Message PopUp en fonction de la date et du statut du dossier

Bonjour à tous,

Je galère depuis quelques jours par rapport à un truc qui paraît tout bête mais qui est pas si simple que ça.

J'ai actuellement un message popup qui s'affiche à l'ouverture du fichier Excel qui indique les articles arrivant à obsolescence dont la deadline est proche (C'est compris entre 0j et 31j). Chose que j'arrive à faire et qui s'affiche parfaitement.

Cette fois je voudrais exclure certaines obsolescences si elles sont closes ou reportés et ne garder que celles qui sont en cours.

Petite précision : le statut de l'obsolescence est présente dans la colonne I et la date de la deadline est présente dans la colonne L.

Le code du message popup :

Option Explicit
Private Sub Workbook_Open()
'*******************
'Variables pour le message popup
'*******************

Dim cl As Range
Dim rng As Range
Dim str As String
Dim sht_str As String
Dim sht As Worksheet

'********************
'Message popup notification des obsolescences arrivant à échéance
'********************

 sht_str = "Attention ! Ces obsolescences arrivent à terme " & Chr(10) & Chr(10)

    For Each sht In Me.Worksheets
    If sht.Name <> "Liste" Then
        sht_str = sht_str & sht.Name & ":"
        str = ""
    Set rng = sht.Range("L2:L250")
    On Error GoTo exit_sub
        For Each cl In rng
            If cl.Value = "" Then GoTo Next_cl
            If IsDate(cl.Value) Then
         If CDate(cl.Value) < Date + 31 And CDate(cl.Value) > Date Then  'Compris entre 31j après la date et 0j après la date
            str = str & Chr(10) & cl.Offset(0, -9) & " le " & cl.Offset(0, 0) & " -> " & cl.Offset(0, 3) & "  " & cl.Offset(0, -3)
          End If
         End If
Next_cl:
        Next cl
            If str = "" Then str = Chr(10) & "Pas d'expiration"
        sht_str = sht_str & str & Chr(10) & Chr(10)
        End If
    Next sht
MsgBox sht_str, 48, "Expiration obsolescences dans moins de 30 jours !"

'********************
'Ouverture du userform
'********************
UserForm1.Show 0
UserForm1.MultiPage1.Value = 0

exit_sub:
End Sub

Merci d'avance et bonne journée !

Bonjour,

UNe idée :
Rajouter à cette ligne une condition sur le statu de l'obsolescence en colonne I :

If CDate(cl.Value) < Date + 31 And CDate(cl.Value) > Date And cl.OffSet(,nombre de colonne vers la droite qui sépare cl de la colonne I) = "En cours" Then

Vous aurez compris que si cl est en colonne B alors le OffSet sera : .OffSet(,7)

@ bientôt

LouReeD

Salut,

Si j'ai bien compris ton code c'est dans la cellule : cl.Offset(0, -3) que contient ton statut donc ca revient à la colonne "L - 3" soit colonne "I" comme tu l'as dit.

Donc j'ai juste rajouté dans ta condition si la valeur de cette cellule est différente de "Clos". Si tu as des "Clos" avec une syntaxe différente faudra rajouter un truc comme ça pour récupérer la bonne syntaxe peut importe si majuscule minuscule et espace invisible ou non.

Trim(UCase(cl.Offset(0, -3).Value)) <> "CLOS"

Je te laisse essayer ;)

Option Explicit
Private Sub Workbook_Open()
'*******************
'Variables pour le message popup
'*******************

Dim cl As Range
Dim rng As Range
Dim str As String
Dim sht_str As String
Dim sht As Worksheet

'********************
'Message popup notification des obsolescences arrivant à échéance
'********************

 sht_str = "Attention ! Ces obsolescences arrivent à terme " & Chr(10) & Chr(10)

    For Each sht In Me.Worksheets
    If sht.Name <> "Liste" Then
        sht_str = sht_str & sht.Name & ":"
        str = ""
    Set rng = sht.Range("L2:L250")
    On Error GoTo exit_sub
        For Each cl In rng
            If cl.Value = "" Then GoTo Next_cl
            If IsDate(cl.Value) Then
         If CDate(cl.Value) < Date + 31 And CDate(cl.Value) > Date And cl.Offset(0, -3).Value <> "Clos" Then  'Compris entre 31j après la date et 0j après la date et différent de "Clos"
            str = str & Chr(10) & cl.Offset(0, -9) & " le " & cl.Offset(0, 0) & " -> " & cl.Offset(0, 3) & "  " & cl.Offset(0, -3)
          End If
         End If
Next_cl:
        Next cl
            If str = "" Then str = Chr(10) & "Pas d'expiration"
        sht_str = sht_str & str & Chr(10) & Chr(10)
        End If
    Next sht
MsgBox sht_str, 48, "Expiration obsolescences dans moins de 30 jours !"

'********************
'Ouverture du userform
'********************
UserForm1.Show 0
UserForm1.MultiPage1.Value = 0

exit_sub:
End Sub

Bonjour à vous deux,

Je vous remercie pour vos réponses et ça marche nickel pour l'exclusion de certaines valeurs .

@tenders_vba : je connaissais pas cette fonction Trim(UCase (" ")), je vais pouvoir le garder dans un coin car je pense que ça peut me servir pour la suite de mon projet !

Bonne journée !