msgbox

Bonjour,

En supposant que c'est le 2ème message qui t'intéresse (le lot a expiré le..) et
que la colonne K soit la dernière que tu utilises, essaye cette modification de
ton code (le message est écrit en colonne L de la ligne concernée) :

'===================== Private Sub Worksheet_Activate()
Dim produit, lot As String
Dim d, mt As Date
Dim i As Integer, Msg$

i = 1
Do
d = Sheets("LISTE").Cells(i, 11).Value
mt = Format(Now, "dd/mm/yyyy")

If d = mt And d <> "" Then
produit = Sheets("LISTE").Cells(i, 4).Value
lot = Sheets("LISTE").Cells(i, 10).Value
MsgBox ("Le lot N°: " & lot & " de : " & produit & _
" arrive à expiration aujourd'hui")
End If

If d < mt And d <> "" Then
produit = Sheets("LISTE").Cells(i, 4).Value
lot = Sheets("LISTE").Cells(i, 10).Value
Msg = "Le lot " & lot & " de produit " & produit _
& " a expiré le " & d
MsgBox Msg
'***************************************
Sheets("LISTE").Cells(i, 12).Value = Msg
'***************************************
End If
i = i + 1
Loop Until i = 10

End Sub
'=====================
FS
---
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://frederic.sigonneau.free.fr
Si votre question sur Excel est urgente, évitez ma bal !

bonjour a tous

dans une macro (que j ai recopier du forum )il y a un message qui m indique
des donnees de mon tableau a une date prevus
je souhaiterais egalement que se message soit imprimer ou soit placer sur
une feuille du claseur actif

Private Sub Worksheet_Activate()
Dim produit, lot As String
Dim d, mt As Date
Dim i As Integer
i = 1
Do
d = Sheets("LISTE").Cells(i, 11).Value
mt = Format(Now, "dd/mm/yyyy")

If d = mt And d <> "" Then
produit = Sheets("LISTE").Cells(i, 4).Value
lot = Sheets("LISTE").Cells(i, 10).Value
MsgBox ("Le lot N°: " & lot & " de : " & produit & " arrive à expiration
aujourd'hui")
Else
End If
If d < mt And d <> "" Then
produit = Sheets("LISTE").Cells(i, 4).Value
lot = Sheets("LISTE").Cells(i, 10).Value
MsgBox ("Le lot " & lot & " de produit " & produit & " a expiré le " & d)

Else
End If
i = i + 1
'Loop Until Sheets("LISTE").Cells(i, 4).Value = ""

Loop Until i = 10


End Sub