1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
| Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim tablCode
tablCode = Array(31, 34, 36, 18, 99)
If Target.Column = 21 Or Target.Column = 24 Or Target.Column = 27 Or Target.Column = 30 Then
For i = 0 To 4
If Target.Value = tablCode(i) Then
'--------------------------------------------------------
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant
Email_Subject = " DL " & tablCode(i)
Email_Send_From = "xxxx@gmail.com"
Email_Send_To = "xxxx@gmail.com"
Email_Cc = "xxxx@gmail.com"
Email_Bcc = "xxxx@gmail.com"
Email_Body = "Auto-mail" & vbCr & _
"" & vbCr & _
"Un code " & tablCode(i) & " a été attribué aujourd'hui" & vbCr & _
"Date : " & Cells(Target.Row, 1) & vbCr & _
"Nom agent: " & Cells(Target.Row, 2) & vbCr & _
"Vol Départ: " & Cells(Target.Row, 13) & vbCr & _
"STD: " & Format(Cells(Target.Row, 18), "hh:mm") & vbCr & _
"ATD: " & Format(Cells(Target.Row, 19), "hh:mm") & vbCr & _
"Durée: " & Format(Cells(Target.Row, 20), "hh:mm") & vbCr & vbCr & _
"DR1: " & Cells(Target.Row, 21) & vbCr & _
"time: " & Format(Cells(Target.Row, 22), "hh:mm") & vbCr & _
"Explication: " & Cells(Target.Row, 23) & vbCr & vbCr & _
"dr2: " & Cells(Target.Row, 24) & vbCr & _
"time: " & Format(Cells(Target.Row, 25), "hh:mm") & vbCr & _
"Explication: " & Cells(Target.Row, 26) & vbCr & vbCr & _
"dr3: " & Cells(Target.Row, 27) & vbCr & _
"time: " & Format(Cells(Target.Row, 28), "hh:mm") & vbCr & _
"Explication: " & Cells(Target.Row, 29) & vbCr & vbCr & _
"dr4: " & Cells(Target.Row, 30) & vbCr & _
"time: " & Format(Cells(Target.Row, 31), "hh:mm") & vbCr & _
"Explication: " & Cells(Target.Row, 32) & vbCr & vbCr & _
"@tt"
On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.cc = Email_Cc
.BCC = Email_Bcc
.Body = Email_Body
.Send
End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description
'----------------------------------------------------------------
End If
Next
End If
End Sub |
Partager