XL 2016 alerte msg box

[michokette]

Bonjour à tous

J'ai trouvé sur le net une macro qui m'affiche des messages d'alertes par rapport à certaines échéances
Actuellement les msg box s'afifchent les unes après les autres
Que faudrait t-il changer dans la macro, pour que tous les messages d'alertes s'affichent dans une seule msgbox (en fait 3 msg box, 1 pour la période d'essai, 1 pour la visite médicale, 1 pour l'entretien pro
En vous remerciant par avance de vos réponses

 

[Eric KERGRESSE]

Bonjour,

A tester :

Sub alerte()

Dim w1 As Worksheet
Dim i As Long
Dim D As Date
Dim j As Integer
Dim Message As String

    Set w1 = Worksheets("feuil1") 'Feuille qui contient les alertes
    D = Date
    Message = ""
    ' ********************************* Période d'éssai
    For i = 2 To w1.Range("D" & Rows.Count).End(xlUp).Row
        p = D - w1.Range("D" & i)
        If p >= 0 Then Message = Message & "Période d'éssai pour  :  " & Cells(i, "A").Value & "  à déja expirée depuis le : " & Cells(i, "D").Value & Chr(10)
        If p > -15 And p < 0 Then Message = Message & "fin de période d'éssai pour " & Cells(i, "A").Value & " expirera le " & Cells(i, "d").Value & Chr(10)
    Next i
   
    ' ********************************* visite midicale
    For i = 2 To w1.Range("E" & Rows.Count).End(xlUp).Row
        p = D - w1.Range("E" & i)
        If p >= 0 Then Message = Message & "Visite midicale pour  :  " & Cells(i, "A").Value & "  à déja expirée depuis le : " & Cells(i, "E").Value & Chr(10)
        If p > -15 And p < 0 Then Message = Message & "Visite midicale pour " & Cells(i, "A").Value & " le " & Cells(i, "e").Value & Chr(10)
    Next i
   
    ' ********************************* Entretien PRO
    For i = 2 To w1.Range("F" & Rows.Count).End(xlUp).Row
        p = D - w1.Range("F" & i)
        If p >= 0 Then Message = Message & "Entretien PRO pour  :  " & Cells(i, "A").Value & "  à déja expirée depuis le : " & Cells(i, "F").Value & Chr(10)
        If p > -15 And p < 0 Then Message = Message & "Entretien PRO pour " & Cells(i, "A").Value & Chr(10)
    Next i
   
    If Message <> "" Then
       MsgBox Message
    End If
   
    Set w1 = Nothing

End Sub

 

[michokette]

Bonjour
Un grand merci pour votre retour
Ca fonctionne tres bien
J'ai modifié le code pour avoir 3 msgbox:
1 pour la periode d'essai
1 pour la visite médicale
1 pour l'entretien pro
Bien cordialement

 

[job75]

Bonjour,

Sub Messages()
Dim tablo, i&, mes1$, mes2$, mes3$
tablo = Sheets("Feuil1").[A1].CurrentRegion.Resize(, 6) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    mes1 = mes1 & vbLf & tablo(i, 1) & vbTab & tablo(i, 4)
    mes2 = mes2 & vbLf & tablo(i, 1) & vbTab & tablo(i, 5)
    mes3 = mes3 & vbLf & tablo(i, 1) & vbTab & tablo(i, 6)
Next
MsgBox Mid(mes1, 2), , tablo(1, 4)
MsgBox Mid(mes2, 2), , tablo(1, 5)
MsgBox Mid(mes3, 2), , tablo(1, 6)
End Sub

A+

 

[michokette]

Bonsoir job75
Merci également pour votre retour qui fonctionne très bien
Bien cordialement