XL 2016 Selectionner date la plus proche au supérieur de la date d'aujourd'hui

[babacool22]

Bonjour le forum !

Après moulte recherche et après avoir passé une bonne partie de ma matinée sur ce problème je m'en remets à vous.
J'ai consulté le forum il y a peu pour mettre au point un planning capable d'envoyer des mails contenant les maintenances à prévoir sur différentes échelles temporelles.
J'ai donc récupérer un code fournis par un membre du forum qui marche à la perfection. Etant débutant dans excel et en VBA, j'ai essayer de "recuisiner" à ma manière le code initial afin de l'adapter à plusieurs cas de figure.
Le code initial prévenait d'une maintenance à aujourd'hui + 14 jours (soit dans 2 semaines). J'ai réussi à le modifier pour faire en sorte qu'il me donne les maintenances du mois suivant entier, des deux prochaines semaines, et de la prochaine semaine.
J'aimerai maintenant ajouté une dernière fonctionnalité qui est de trouver directement quelle sera la prochaine machine en maintenance et uniquement la suivante.

Sub Envoyer_mail2()

    Dim oOutlook As Object  ' Objet application Outlook
    Dim MaDate As Date
    Dim c As Range, Plage As Range
    Dim Machines As String
    
    Set Plage = ThisWorkbook.Sheets("Planning maintenance préventive").Range("D5:D56")
    
    MaDate = Date


    On Error GoTo FIN

    ' Compter combien de date = limite dans la plage
    ' pour envoyer l'email ou alerter l'utilisateur
    If Application.CountIf(Plage, MaDate) > 0 Then
        '
        ' Parcourir les cellules de la plage
        ' à la recherche des machines qui corresponde à la date de maintenance prévue
        ' en construire une liste textuelle pour le corps du message
         For Each c In Plage
            ' le nom de la machine se trouve à 2 colonnes à gauche de la colonne de date
            ' lf = saut de ligne
            If c.Value2 >= MaDate Then Machines = Machines & vbLf & c.Offset(, -2)
         Next
        
        ' Création de l'application Outlook
        Set oOutlook = CreateObject("Outlook.Application")    'création d'un objet outlook

        ' Travailler sur un objet email créée
        With oOutlook.CreateItem(olMailItem)
            .Subject = "Alerte maintenance préventive"
            .To = Range("E3")    ' Destinataire
            .Body = "Liste des machines dont la maintenance est prévue le " & _
                     " : " & vbLf & Machines
            .Display 'afficher le mail avant de l'envoyer ou send pour envoyer
        End With
    Else

        MsgBox "Opération annulée : Aucune tâche n'a été trouvée!", vbInformation, "Envoi mail de rappel"
    
    End If

FIN:
    '
    ' Si une erreur a été rencontrée, prévenir l'utilisateur
    If Err.Number <> 0 Then
        MsgBox "Opération échouée en raison de l'erreur suivante :" & vbCrLf & vbCrLf & _
               "Numéro de l'erreur: " & Err.Number & vbCrLf & vbCrLf & "Description: " & Err.Description, _
               vbExclamation, "Envoi mail de rappel de tache"
    End If
    '
    On Error GoTo 0
    '
    '   Toujours détruire correctement les variables objets pour éviter les fuites de mémoire
    Set oOutlook = Nothing
End Sub

Dans ce code-ci j'arrive à faire apparaître toutes les machines en maintenances en se fixant sur le critère >=MaDate (date du jour), sauf qu'avec le next il continue de me prendre des valeurs et ne s'arrête pas à une seule. De plus il parcourt ma plage de date de haut en bas et même si il s'était arrêter sur la première valeur >=MaDate il y a de forte chance pour que ce ne soit pas celle qui soit le plus proche de la date du jour.
Je ne sais pas si j'ai était clair, je reste à votre disposition pour toutes informations jugées nécessaires.
Ci-joint vous pouvez retrouver le excel en question.
Dans l'attente de vous lire,
Cordialement,

Babacool22

 

[babacool22]

Bonjour le forum !

Je reviens vers vous car j'ai trouvé la solution et je viens la partager.

Dim MinDate As Long

For Each c In Plage
    'le nom de la machine se trouve à 2 colonnes à gauche de la colonne de date
    If c.Value2 >= MaDate Then
        If MinDate = 0 Or c.Value2 < MinDate Then
            MinDate = c.Value2
            Machines = c.Offset(, -2)
        End If
    End If
Next

Cordialement,

Babacool22

 

[sylvanu]

Bonjour Babacool,

De plus il parcourt ma plage de date de haut en bas

De toute façon pour trouver la date la plus proche, on est obligé de parcourir tout le tableau puisqu'en colonne D les dates sont dans le désordre.
Sans l'avoir testé, une possibilité avec :

         Diffdate = 9 ^ 9: Ligne = 0                    ' DiffDate est l'écart entre la date en D et aujourd'hui, en valeur absolue.
         For Each c In Plage
            If Abs(c.Value2 - MaDate) < Diffdate Then   ' Calcul de la différence de date
                Ligne = c.Row                           ' Si < alors on mémorise le N° de ligne
                Diffdate = Abs(c.Value2 - MaDate)       ' On réactualise la diff de date minimum trouvée
            End If
         Next
         Machines = Machines & vbLf & Cells(Ligne, "B") ' Col B deux colonnes à gauche de Col D

 

[babacool22]

Bonjour @sylvanu,

Merci pour ton retour et d'avoir pris du temps sur ma problèmatique.

Je viens d'essayer ta solution sur mon classeur, j'ai remplacer ma partie que j'ai mise plus haut par ta partie et j'ai intégrer tes variables. Lorsque je lance la macro, l'erreur 6 se lance et en description d'erreur : dépassement de capacité.

Je n'ai malheuresement pas les capacités pour résoudre ce problème ni même comprendre d'où peut venir l'erreur...

Encore merci pour ton implication !!

Cordialement,
Babacool22

 

[sylvanu]

Bonsoir,
Error 6 sur quelle ligne ?
Avez vous déclaré en variable Diffdate ? Si oui, attention 9^9 est très grand, essayez d'initialiser Diffadte à 255 pour voir, peut être est ce simplement que vous avez déclaré Diffdate en integer.

 

[babacool22]

Bonjour @sylvanu, bonjour le forum,

J'ai apporter les modifications que vous m'avez proposé. Le code marche parfaitement. J'avais déclaré Diffdate as Date et j'ai déclaré une première fois Ligne as Range, ça n'a pas marché je l'ai donc mis en Variant et la ça a marché à la perfection.

Merci beaucoup pour ton implication et ton aide précieuse.

Cordialement,
Babacool22