Koşullu Mail Gönderme

[cember68]

Merhaba.Aşağıda yazılan kod ile T42 hücresi "uygun değil" ise T2 bilgisi ile beraber verilen adrese uyarı maili gönderiyor.Aynı şekilde 3 koşulum daha var bunları ilave edemedim.

İlave olarak R42 hücresi "uygun değil" ise R2 bilgisi ile
İlave olarak S42 hücresi "uygun değil" ise S2 bilgisi ile
İlave olarak U42 hücresi "uygun değil" ise U2 bilgisi ile aynı maile uyarı gönderebilirim?

yani tüm "uygun olmayan " hücreleri (R42,S42,T42,U42) bilgisi (R2,S2.T2,U2) ile gönderebilirmiyim?


SONUÇ OLARAK ÖRNEK:Sayın Denetci B19-431-28.Nolu Raporda.3.KRİTER (İKİLİ GRUPLAR ARASINDAKİ FARK 3 TEN FAZLA OLAMAZ) Uygun Olmayan Değer Var...
Sayın Denetci B19-431-28.Nolu Raporda.1.KRİTER (fcm≥ fck+1.0 & 2.0) Uygun Olmayan Değer Var...

Yardımcı olabilirmisiniz?



Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Range("t42").Value = "UYGUN DEĞİL" Then



Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = "Sayın Denetci " & ActiveSheet.Range("H4").Value & ".Nolu Raporda." & ActiveSheet.Range(" t2 ").Value & " Uygun Olmayan Değer Var..."



On Error Resume Next
With OutMail
.To = "turan@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Sayın Denetci " & ActiveSheet.Name
.Body = strbody

.Send
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing



End If

End Sub

 

[yanginci34]

Aşağıdaki gibi denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i
For i = 18 To 21
If ActiveSheet.Cells(42, i).Value = "UYGUN DEĞİL" Then



Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = "Sayın Denetci " & ActiveSheet.Range("H4").Value & ".Nolu Raporda." & ActiveSheet.Cells(2, i).Value & " Uygun Olmayan Değer Var..."



On Error Resume Next
With OutMail
.to = "turan@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Sayın Denetci " & ActiveSheet.Name
.Body = strbody

.Send
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing



End If
Next i

End Sub

 

[cember68]

Aşağıdaki gibi denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i
For i = 18 To 21
If ActiveSheet.Cells(42, i).Value = "UYGUN DEĞİL" Then



Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = "Sayın Denetci " & ActiveSheet.Range("H4").Value & ".Nolu Raporda." & ActiveSheet.Cells(2, i).Value & " Uygun Olmayan Değer Var..."



On Error Resume Next
With OutMail
.to = "turan@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Sayın Denetci " & ActiveSheet.Name
.Body = strbody

.Send
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing



End If
Next i

End Sub

Hocam çok teşekkür ederim.Fakat benim R42 ,S42,T42,U42 hücrelerimdeki kriterlerde sadece bir tanesini alıyor.Aynı anda R42 ,S42, T42,U42 "UYGUN DEĞİL" olabiliyor.Herhangi biri veya hepsi birden de "UYGUN DEĞİL" olabiliyor.Fakat maile sadece bir kriteri alıyor.Maile alt alta uygun olmayanları yazabilir miyim?

ÖRNEK OLARAK :Sayın Denetci B19-431-28.Nolu Raporda.3.KRİTER (İKİLİ GRUPLAR ARASINDAKİ FARK 3 TEN FAZLA OLAMAZ) Uygun Olmayan Değer Var...
Sayın Denetci B19-431-28.Nolu Raporda.1.KRİTER (fcm≥ fck+1.0 & 2.0) Uygun Olmayan Değer Var...

 

[cember68]

Tamam Hocam Çok teşekkür ederim.Ben eski maillerle karıştırmışım.İstediğim gibi çalışıyor.Çok sağolun.

 

[yanginci34]

Rica ederim sizde sağolun.