Macro envoie de mail quand la date a expiré

Bonjour à tous !

Malgré de multiples recherches je n'ai pas trouver la réponse que je cherchais. Je m'excuse par avance si un sujet similaire existe déjà.

Je vous présente ma problématique :

J'ai une liste d'employés avec l'équipe dans laquelle ils sont et une liste de formation + la date à laquelle tel ou tel employé à effectué la dite formation. Les formations sont valable 2 ans.

j'ai fait une mise en forme conditionnelle pour faire ressortir les dates qui ont plus de 2 ans, qui aurons 2 ans dans 2 mois ou qui sont encore dites "valide"

j'ai aussi réalisé des macro très simples pour trier automatiquement les dates dans l'ordre croissant ou les employés de A à Z

Ce que j'aimerais c'est créer 1 bouton (ou plusieurs suivant ce qui est le plus facile) qui permettrais de trier dans une même équipe quels sont les personnes dont au moins une formation est arrivé à expiration ou arrivera à expiration dans les deux prochains mois. et envoyer un mail pré-formaté à l'adresse mail correspondant à l'équipe.

dans le mail l’objet serait : Formation à refaire

"Bonjour,

Veuillez trouver ci-joint la liste des formations à refaire pour les personnes suivantes

[Insérer ici le tableau ne contenant que les personnes de l'équipe en question qui ont au minimum une formation qui n'est pas à jour]

Merci de régulariser ceci au plus tôt

Cordialement;

Phile"

je vous joint un fichier qui à une forme équivalente à celui que j'utilise professionnellement. j'aurais aimé vous donner l'original mais pour des raisons de confidentialités cela n'est pas possible. veuillez m'en excuser.

N'hésitez pas à demander si vous avez besoin de précision sur ma demande, je sais que parfois je ne suis pas assez clair.

Merci d'avance

Bonne journée/soirée/nuit à vous !

Bonjour Phile,

Je t'ai fait une routine pour que tu me valides les formations à faire :

Sub ListeFormationsEchues()
   Dim l As Long, c As Long, n As Long, y As Long, e As Long, dDateMin As Date, DateMax As Date, aEquipes()
   Dim Sh As Worksheet, ShAct As Worksheet

   dDateMin = DateAdd("yyyy", -2, Date)
   DateMax = DateAdd("m", 2, dDateMin)

   Set ShAct = ThisWorkbook.Worksheets(1)
   ColEquipe = Columns("C").Column

   aEquipes = ShAct.Range("Equipes")

   Application.ScreenUpdating = False

   With Workbooks.Add
      Set Sh = .Worksheets(1)
   End With

   For c = 1 To Columns("D").Column
      Sh.Cells(1, c) = ShAct.Cells(1, c)
   Next c
   Sh.Cells(1, c) = "Formation"
   Sh.Cells(1, c + 1) = "Date"
   Sh.Columns(c + 1).NumberFormat = "dd/mm/yyyy"
   Sh.Rows(1).Font.Bold = True: Sh.Rows(1).Font.Underline = True

   x = 1
   For e = LBound(aEquipes, 1) To UBound(aEquipes, 1)
      For l = 2 To ShAct.UsedRange.Rows.Count
         If ShAct.Cells(l, "A") <> Empty Then
            If aEquipes(e, 1) = ShAct.Cells(l, ColEquipe) Then
            For c = ShAct.Columns("E").Column To ShAct.Columns("I").Column
               If ShAct.Cells(l, c) <= DateMax Then
                  x = x + 1
                  For y = 1 To ShAct.Columns("D").Column
                     Sh.Cells(x, y) = ShAct.Cells(l, y)
                  Next y
                  Sh.Cells(x, y) = ShAct.Cells(1, c)
                  Sh.Cells(x, y + 1) = ShAct.Cells(l, c)
               End If
            Next c      ' Colonne
         End If ' Cohérence de l'équipe
         End If      ' Ligne non vide
      Next l      ' ligne
   Next e      ' Equipe

   Application.ScreenUpdating = False
End Sub

Quel logiciel de messagerie utilises-tu ? Si c'est Outlook, je pourrais continuer à t'aider assez facilement, sinon ça va être plus compliqué.

Hello !

C'est bien quelque chose comme ça que je cherche,

j'airais aimé garder la forme du tableau et aussi la couleur de la mise en forme conditionnelle (cela permet de montrer dans le mail à quelle point la formation est urgente si elle est en rouge par rapport à une formation en orange)

Oui j'utilise outlook comme logiciel de messagerie

Bonsoir,

Ca donnerai quelque chose comme cela :

Sub ListeFormationsEchues()
   Dim l As Long, c As Long, n As Long, y As Long, e As Long, dDateMin As Date, dDateMax As Date, aEquipes()
   Dim Sh As Worksheet, ShAct As Worksheet, bUrgent As Boolean, bCpyObject As Boolean

   bCpyObject = Application.CopyObjectsWithCells
   Application.CopyObjectsWithCells = False

   dDateMin = DateAdd("yyyy", -2, Date)
   dDateMax = DateAdd("m", 2, dDateMin)

   Set ShAct = ThisWorkbook.Worksheets(1)
   ColEquipe = Columns("C").Column

   aEquipes = ShAct.Range("Equipes")

   Application.ScreenUpdating = False

   With Workbooks.Add
      Set Sh = .Worksheets(1)
   End With

   ShAct.Cells(1, "A").Resize(, 9).Copy Sh.UsedRange.Cells(1, "A").Resize(, 9)

   x = 1
   For e = LBound(aEquipes, 1) To UBound(aEquipes, 1)
      For l = 2 To ShAct.UsedRange.Rows.Count
         bUrgent = False
         If ShAct.Cells(l, "A") <> Empty Then
            If aEquipes(e, 1) = ShAct.Cells(l, ColEquipe) Then
               For c = ShAct.Columns("E").Column To ShAct.Columns("I").Column
                  If ShAct.Cells(l, c) <= dDateMax Then
                     x = x + 1
                     bUrgent = True: Exit For
                  End If
               Next c      ' Colonne
               If bUrgent Then
                     ShAct.Cells(l, "A").Resize(, 9).Copy Sh.UsedRange.Cells(x, "A").Resize(, 9)
               End If
            End If   ' Cohérence de l'équipe
         End If      ' Ligne non vide
      Next l      ' ligne
   Next e      ' Equipe

   Application.ScreenUpdating = False
   Application.CopyObjectsWithCells = bCpyObject
End Sub

Ca te va ?

phile a écrit :

j'airais aimé garder la forme du tableau et aussi la couleur de la mise en forme conditionnelle (cela permet de montrer dans le mail à quelle point la formation est urgente si elle est en rouge par rapport à une formation en orange)

il est possible de faire un copier/coller dans le corps du mail dans ce cas !

Yep !

merci beaucoup ! cela me permettra de gagner pas mal de temps !

@Steelson : Effectivement c'est possible ^^ merci