Obtenir une message box en fonction du dépassement d'une date

Question

Bonjour, je me suis jamais servi de Workbook mais j'ai un début de code pour obtenir une message box lorsqu'une date d’échéance d'une facture. Lorsque la date d'échéance + 30 jours est dépassée, la message box doit s'afficher en indiquant que la facture doit être relancée.

J'ai la message box qui s'affiche cependant cela prend en compte l'entièreté de mes factures.

Voila le code que j'ai réussi à créer :

Private Sub Workbook_Open()
'Relance facture à la date d'échéance + 30 jours
Dim Date_échéance As Range
Dim LDate As Date
For Each Date_échéance In ActiveSheet.Range("DateEcheance")
Valeur = Cells(Date_échéance.Row, 2)
If (LDate + 30) > DateEcheance Then
        MsgBox "La facture " & Valeur & " doit être relancée", vbExclamation, "Facture à relancer"
    Else
        MsgBox "Rien à relancer"
    End If
Next
End Sub

J'ai essayé de regarder un peu partout et essayé un peu tout comme :

If Date + 30 > DateEcheance Then

J'espère avoir bien expliqué ma situation, et merci d'avance !

Pedro22 · Answer

Vous avez une bonne base, mais vous utilisez une variable LDate, destinée à recevoir une date, mais qui n'est pas initialisée (aucune valeur ne lui est affectée). Du coup, elle garde la valeur 0 par défaut, et toutes les dates sont comparées à 0 + 30 (correspond au 31/01/1900)... Autre remarque, ActiveSheet est à mon avis inutile, car votre plage nommée correspond déjà à une plage particulière sur une feuille particulière (qu'il n'y a pas lieu de re-préciser). Enfin, la seconde MsgBox risque de s'afficher à de nombreuses reprises pour tous les cas sans relance. Je pense donc qu'il faudrait modifier cette partie pour ne l'afficher qu'une seule fois, s'il n'y a effectivement aucune relance à effectuer. Une proposition : Private Sub Workbook_Open() 'Relance facture à la date d'échéance + 30 jours Dim Date_échéance As Range, AuMoinsUneRelance As Boolean For Each Date_échéance In Range("DateEcheance") If (Date + 30) &gt; DateEcheance Then 'PS : "Date" équivaut à la fonction Excel =AUJOURDHUI() MsgBox "La facture " &amp; Cells(Date_échéance.Row, 2) &amp; " doit être relancée", vbExclamation, "Facture à relancer" AuMoinsUneRelance = True End If Next If Not AuMoinsUneRelance Then MsgBox "Rien à relancer" End Sub Selon le contenu de votre fichier, il faudrait peut être ajouter des conditions supplémentaires pour ne pas demander de relance sur une facture déjà relancée, etc.....

pijaku · Answer

Private Sub Workbook_Open() 'Relance facture à la date d'échéance + 30 jours Dim Date_échéance As Range Dim LDate As Date For Each Date_échéance In ActiveSheet.Range("DateEcheance") Valeur = Cells(Date_échéance.Row, 2) 'ICI, il convient d'affecter une valeur à la variable LDate ! LDate = CDate(Date_échéance.Value2) If (LDate + 30) &gt; DateEcheance Then MsgBox "La facture " &amp; Valeur &amp; " doit être relancée", vbExclamation, "Facture à relancer" Else MsgBox "Rien à relancer" End If Next End Sub...

Pedro22 · Answer

Attention, sauf erreur de ma part, ta proposition est ambiguë ! Elle revient ensuite à comparer LDate avec elle-même : If (LDate + 30) &gt; LDate Then '&lt;-- c'est toujours VRAI ...

pijaku · Answer

C'est pas faux... J'ai répondu trop vite. Vais me prendre vite fait un p'tit café.....

Pedro22 · Answer

La macro présente dans ce fichier est celle d'origine, donc il est normal que le problème persiste !! Perceval Je viens de prendre le mien, ça aide ...

Pedro22 · Answer

C'est lié à un autre problème dans votre fichier... Les données en colonne D ressemblent à des dates, mais n'en sont pas ! Une date valide est convertible en nombre lorsqu'on change sont format. Ce nombre correspond aux jours écoulés depuis la date de référence du 01/01/1900 . Actuellement, il s'agit donc d'un texte. Ce qui revient dans la macro à tester : If Date + 30 &gt; 0 Then 'C'est toujours vrai... Soit vous modifiez vos données pour les convertir en date, par exemple à l'aide de l'outils "Convertir" dans le menu "Données" (méthode conseillée). Soit vous modifiez la macro pour traduire le texte date en date valide au moment de le comparer (non conseillé) : If (Date + 30) &gt; CDate(DateEcheance) Then...

Pedro22 · Answer

Je viens de repérer une autre erreur. Attention à l'écriture des noms des variables : DateEcheance est différente de Date_échéance.

Enfin, vu le contenu de la colonne H, je pense que la comparaison n'est pas bonne... On cherche à faire :

Si AUJOURDHUI()>DateEchéance+30 Alors...

Et pas :

Si AUJOURDHUI() + 30 >DateEchéance Alors...

Pedro22 · Answer

Compte tenu de toutes les remarques précédentes, voilà une macro corrigée : Private Sub Workbook_Open() 'Relance facture à la date d'échéance + 30 jours Dim Date_échéance As Range, AuMoinsUneRelance As Boolean For Each Date_échéance In Range("DateEcheance") If Date &gt; CDate(Date_échéance) + 30 Then MsgBox "La facture " &amp; Cells(Date_échéance.Row, 2) &amp; " doit être relancée", vbExclamation, "Facture à relancer" AuMoinsUneRelance = True End If Next If Not AuMoinsUneRelance Then MsgBox "Rien à relancer" End Sub...

Pedro22 · Answer

Merci du retour et pour la validation, j'espère avoir été limpide dans mes explications ...

pijaku · Answer

Bon ... J'arrive trop tard, mais le café a été long à faire...

Voici une proposition basée sur le code de l'ami Pedro :

Private Sub Workbook_Open()
'Relance facture à la date d'échéance + 30 jours
Dim Date_échéance As Range, S() As String, i As Integer
    ReDim S(i)
    S(i) = "La(es) facture(s) :"
    For Each Date_échéance In Range("DateEcheance")
       If Date > DateAdd("d", 30, Date_échéance.Value2) Then 'PS : "Date" équivaut à la fonction Excel =AUJOURDHUI()
            S(i) = S(i) & "   " & Cells(Date_échéance.Row, 2)
        End If
        If Len(S(i)) > 800 Then i = i + 1: ReDim Preserve S(i)
    Next
    If UBound(S) = 0 Then
        MsgBox S(0), vbExclamation, "Facture à relancer"
    Else
        For i = LBound(S) To UBound(S)
            MsgBox LTrim$(S(i)), vbExclamation, "Facture à relancer"
        Next
    End If
End Sub