Private Sub CommandButton3_Click() 'COURRIER OU VERIF
Dim OutApp As Object, OutMail As Object
Dim Debut$, Fin$
Dim rng As Range
Dim i&, j&
With Application
.EnableEvents = 0
.ScreenUpdating = 0
End With
Sheets.Add After:=Sheets(Sheets.Count)
j = 2
With Sheets(1)
Sheets("NOTE").Rows(1).Copy .Rows(1)
For i = 2 To [A65536].End(xlUp).Row
If Sheets("NOTE").Cells(i, 1) = "COURRIER" Then 'Or .Cells(i, 1) = "VERIF"' POUR 2 CRITERE
Sheets("NOTE").Rows(i).Copy .Rows(j)
j = j + 1
End If
Next
End With
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("NOTE").Range("A1:C" & [A65536].End(xlUp).Row)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
Debut = "Bonjour , <BR>.<BR>"
Fin = "<BR>.<BR>"
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "xxxxxxxxxxx@romandie.com"
.CC = "xxxxxxxxxxx@hotmail.com"
.BCC = ""
.Subject = "COURRIER DU " & Cells(1, 1)
.HTMLBody = Debut & RangetoHTML(rng) & Fin
.Display
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = 0
ActiveSheet.Delete
MsgBox "COURRIER ENVOYES"
With Application
.EnableEvents = -1
.ScreenUpdating = -1
.DisplayAlerts = -1
End With
End Sub
