Sub cc2()
'Dim MonOutlook As New Outlook.Application, MonMessage As Object
'Tri des listes
Sheets("Liste").Select
'Application.Run "'facturation.xls'!Macro3"
Call Macro3
Sheets("saisie").Select
ActiveSheet.Unprotect
'Envoi des mails
A = Cells(6, "AB")
B = Cells(7, "AB")
For i = A To B
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
With MonMessage
'ad = destinataires
ad = Cells(i, "Y").Value
'corps = corps du message
corps = Cells(i, "AA").Value & vbCrLf & "Cordialement" & vbCrLf & Cells(8, "AJ").Value
If ad <> "" Then .To = ad 'ad est soit déterminé dans la macro ou à saisir dans le champ adresse manuellement
.Subject = "Chantier " & Cells(i, "D").Value & " - " & Cells(i, "E").Value & " - Echantillons à purger"
'.Subject = "Factures arrivant à échéances"
.Body = "Bonjour," & vbCrLf & "Attention !! ça degage :" & vbCrLf & vbCrLf & corps & vbCrLf
If ad <> "" Then
'mettre en Bleu les destinataires ayant reçu leur mail
Cells(i, "AC").Font.ColorIndex = 5
Cells(i, "AD").Font.ColorIndex = 5
'cochez case si mail envoyé
Cells(i, "AB").FormulaR1C1 = "x"
'En colonne X, nom de l'expediteur
Cells(i, "AC").FormulaR1C1 = MonOutlook.session.CurrentUser.Name
'En colonne Y, Date d'envoi
Cells(i, "AD").FormulaR1C1 = Now
'SendKeys "^" & "~"
.display
'SendKeys "^" & "~"
'.Send
Else
Set MonMessage = Nothing
Set MonOutlook = Nothing
'SendKeys "^" & "~"
End If
End With
'SendKeys "^" & "~"
Next i
'SendKeys "^" & "~"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub