Code VBA msgbox date d'échéance+ 5 mois

Bonjour à tous,

J'ai essayé plusieurs code trouver sur se forum mais toujours sans réussite avec mon type de fichier.

J'aimerais avoir un msgbox a l'ouverture du fichier nous indiquant les l'état de nos documents. En utilisant les termes du fichiers : msgbox indiquant quand une date de la colonne D (date du dossier de conduite) + 5 mois arrive a échéance.

Il faudrait que le msgbox indique le texte suivant : Dossier de [Prénom (colonne c), Nom(colonne b)] arrive a échéance dans 30 jours.

Si possible ajouter une fonction que si nous modifions la date, le message n'apparaît pas.

Merci !!

Bonjour,

Est-ce qu'une solution plus simple via formule pourrait vous convenir ? Car si j'ai bien compris, dans l'exemple la majorité des dossiers sont "en retard", donc ça vous ferait une MsgBox gigantesque et pas pratique. Alors qu'avec un tableau filtré on a tout sous les yeux.

La formule que j'ai utilisé renvoie les dossiers pour lesquels [date en colonne D + 5 mois] – Aujourdhui < 30 (jours).

=LET(myArr;B3:E97;
fullArr;HSTACK(myArr;EDATE(CHOOSECOLS(myArr;3);5)-TODAY());
filterArr;FILTER(fullArr;TAKE(fullArr;;-1)<30);
SORTBY(filterArr;TAKE(filterArr;;-1)))

Si vous préférez du VBA tout de même, c'est aussi possible, mais précisez ce que vous entendez par "arrive à échéance", il faut des chiffres.

En fait le fichier sera mis a jour aujourd'hui, donc les dates ne seront pas encore a échéance. Mais si on veut un msgbox, j'imagine que ce serait moins compliqué d'avoir un msg box disant : Vous avez des dossiers qui sont a échéance.

De cette façon la personne qui ouvre le document portera une attention particulière à la liste.

Bonjour,

Oui, je comprends l'utilité. Ci-joint le classeur avec la macro que vous demandiez : lors de l'ouverture, un petit calcul est fait pour trouver les échéances dans votre tableau et vous indique le nombre.

Deux points importants :

Si votre tableau bouge, qu'il ne commence plus en B2 (plus bas ou plus à droite), la macro devra être adaptée en conséquent.

Comme vous êtes sur une version récente d'Office, l'exécution des macros sera bloquée puisqu'il s'agit d'un fichier en provenance du Web pour votre PC. Pour "débloquer" les macros, suivez ces instructions. Peut etre qu'il faudra l'ouvrir 2x, si vous avez le pop-up d'activation des macros la première fois.

Voilà, bon c'est adaptable bien entendu. J'ai laissé le tableau de la formule que vous pouvez déplacer où bon vous semble, à part sous le tableau initial (cette zone doit absolument rester vide).

Le code macro :

Private Sub Workbook_Open()
  ' variables de calcul, adaptables ici
  Dim JOURS_MARGE As Long: JOURS_MARGE = 30
  Dim MOIS_AJOUT As Long: MOIS_AJOUT = 5

  Dim dateLim As Date
  dateLim = WorksheetFunction.EDate(Date, -1 * MOIS_AJOUT) + JOURS_MARGE

  ' tri sur la colonne D (B "+" 3 avec B=1) pour les dates inférieures a dateLim
  Dim wsht As Worksheet: Set wsht = ThisWorkbook.Worksheets("Feuil1")
  wsht.Range("B2").AutoFilter 3, "<=" & Format(dateLim, "yyyy-mm-dd")

  Dim lastRow As Long, nbEcheance As Long
  lastRow = wsht.Cells(wsht.Rows.Count, 2).End(xlUp).Row

  nbEcheance = Range(wsht.Range("B3"), wsht.Cells(lastRow, 2)). _
    SpecialCells(xlCellTypeVisible).Count

  ' retirage du filtre
  wsht.Range("B2").AutoFilter

  ' message utilisateur
  Dim msg As String
  If nbEcheance > 1 Then
    msg = "Vous avez " & nbEcheance & " dossiers qui arrivent à échéance dans moins de " & MOIS_AJOUT & " mois."
  Else
    msg = "Tout est en ordre, aucune échéance avant " & MOIS_AJOUT & " mois."
  End If
  MsgBox msg, vbInformation, "Vérification au lancement"
End Sub