Ir para conteúdo
Fórum Script Brasil

Btsmiranda

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Posts postados por Btsmiranda

  1. Amigos,

    alguém que possa me ajudar na fórmula abaixo? preciso que o Excel mande o email do conteúdo da linha quando o resultado da formula = "SOLICITAR". fiz também no Private Sub Worksheet_Change(ByVal Target As Range) End Sub funciona só que tenho que DIGITAR SOLICITAR quero que leia da Fórmula direto.

    Private Sub Worksheet_Calculate()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim texto As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    linha = ActiveCell.Row - 1
    If Target.Address = "$H$" & linha Then -- Quando chega aqui para
    If Plan1.Cells(linha, 8) = "SOLICITAR" Then
    Email = Plan1.Cells(linha, 11)
    cc = Plan1.Cells(linha, 12)
    texto = "<font color=000000><font face=calibri><font size=3><body><br /><br>" & vbCrLf & _
    "<b>Prezado,</b>" & "" & vbCrLf & vbCrLf & _
    "<p>Informamos que o documento " & Plan1.Cells(linha, 1) & " de número " & Plan1.Cells(linha, 2) & " está na época de renovação, favor verificar informações abaixo para providências: " & vbCrLf & _
    "<p>" & vbCrLf & _
    "<b>Documento: </b> " & Plan1.Cells(linha, 1) & vbCrLf & _
    "<p><b>Número: </b> " & Plan1.Cells(linha, 2) & vbCrLf & _
    "<p>" & vbCrLf & _
    "<b>Origem:</b> " & Plan1.Cells(linha, 3) & vbCrLf & _
    "<p>" & vbCrLf & _
    "<b>Data Emissão:</b> " & Plan1.Cells(linha, 4) & vbCrLf & _
    "<p>" & vbCrLf & _
    "<b>Vencimento:</b> " & Plan1.Cells(linha, 6) & vbCrLf & _
    "<p>" & vbCrLf & _
    "<b>Observação:</b> " & Plan1.Cells(linha, 10) & vbCrLf & _
    "<p>" & vbCrLf & _
    "<p>Email Automatico," & vbCrLf & _
    "<p>Favor Não Responda esse email."
    With OutMail
    .To = Email
    .cc = cc
    .BCC = ""
    .Subject = "Documenta próxima da data de vencimento" & " | " & Plan1.Cells(linha, 1) & " N° " & Plan1.Cells(linha, 2)
    .HTMLBody = texto
    .Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    End If
    End If
    End Sub
×
×
  • Criar Novo...