Salut,
Vă rugăm să încercați codul de mai jos
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Range("c:c"), Target) Is Nothing Then Exit Sub
If Target.Value = "done" Then
Set xRg = Target.Offset(0, -1) 'Find email address
Call Mail_small_Text_Outlook(xRg.Value)
End If
End Sub
Sub Mail_small_Text_Outlook(ByVal xTo As String)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = xTo
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use
' .Send
End With
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Ați menționat că doriți să trimiteți un e-mail către PM ale cărui inițiale ca în același rând care au marcat ca finalizate. Adresa lui de e-mail este pe același rând? Codul din al 6-lea rând ajută la găsirea inițialelor managerilor de proiect, îl puteți schimba pentru a-l face să găsească adresa de e-mail.
Vă rugăm să schimbați șirul „terminat” din al 5-lea rând cu șirul real pe care îl utilizați pentru a marca lucrarea finalizată.
Rețineți că puteți modifica fragmentul de mai jos în funcție de nevoile dvs.
xMailBody = „Bună ziua” & vbNewLine & vbNewLine & _
„Aceasta este linia 1” & vbNewLine & _
„Aceasta este linia 2”
La data de eroare CV următoare
Cu xOutMail
.To = xTo
.CC = ""
.BCC = ""
.Subject = "trimite prin testul valorii celulei"
.Body = xMailBody
.Afișează sau folosește
' .Trimite
Se termina cu
Dacă aveți întrebări, vă rugăm să nu ezitați să mă întrebați.
Amanda