Visual Basic Executar uma macro quando o valor de uma célula se altera

Cândido Lorencini · 29 de agosto de 2019

Oi pessoal estou com um problema que não consigo resolver.

O que eu queria fazer era o seguinte:

Sempre que o valor constante linha 16 for igual ao valor da linha 9, a macro executasse automaticamente, ou seja, enviando um e-mail com a informação, segue eu precisasse digitar o valor na linha. Somente funciona se eu digitar o valor e clicar em Enter.

Obs.: A linha 9 é uma fórmula, ou seja, não digito o valor.

Na linha 16, o valor é digitado e quando o valor da linha 9 (que é fórmula) atingir automaticamente o valor da linha 16, o e-mail é disparado.

O que necessito é que o e-mail fosse disparado automaticamente, sem que eu necessitasse de digitar o valor e clicar em Enter.

Segue abaixo a macro que de estou tentando resolver o problema:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim OutApp As Object
    Dim OutMail As Object
    Dim texto As String
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    linha = Target.Row
    If Target.Address = "$I$" & linha Then
        If Planilha11.Cells(linha, 16) = Planilha11.Cells(linha, 9) Then
            
            With OutMail
                .To = "[email protected]"
                .CC = ""
                .BCC = ""
                .Subject = " A Ação " & Planilha11.Cells(linha, 1) & "," & " atingiu o valor " & Planilha11.Cells(linha, 16)
                .Body = texto
                .Send   'Utilize Send para enviar o email sem abrir o Outlook
                End With
        End If
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    End If
End Sub

Charley Rocha · 29 de agosto de 2019

Bem vindo ao Fórum!

Seu problema está aqui:

If Target.Address = "$I$" & linha Then

Sua macro só executa a verificação

If Planilha11.Cells(linha, 16) = Planilha11.Cells(linha, 9) Then

Quando o cursor aponta para a célula "I" & linha.

Se você retirar esse primeiro "IF" deve funcionar.

Cândido Lorencini · 29 de agosto de 2019

Obrigado por responder.

A macro é executada, porém, não é de forma automática.Está executando de forma manual.

Preciso que a macro execute sem a necessidade de clicar no Enter, ou seja, quando a fórmula atingir o valor (sem digitação e sem clicar no enter) que seja executada a macro.

Charley Rocha · 29 de agosto de 2019

2 minutos atrás, candidofla disse:

Obrigado por responder.

A macro é executada, porém, não é de forma automática.Está executando de forma manual.

Preciso que a macro execute sem a necessidade de clicar no Enter, ou seja, quando a fórmula atingir o valor (sem digitação e sem clicar no enter) que seja executada a macro.

Você tentou o que eu sugeri? Qual foi o resultado?

Cândido Lorencini · 29 de agosto de 2019

Sim tentei, porém, a macro não envia o e-mail automático quando o resultado da fórmula de uma célula atinge o valor da outra célula.

Exemplo:

Célula I3 é igual a seguinte fórmula:

=Hoje()

Célula P3 = 29/08/2019

A macro somente executa se eu digitar a data e clicar em enter

Estou querendo da seguinte formar:

Se eu deixar a célula I3 com a fórmula =Hoje ()

E a célula P3 com a data de amanhã 30/08/2019

Desta forma, amanhã eu abrir a planilha, a macro seja executada, pois, as datas serão as mesmas e eu não precisaria digitar a data e não precisaria clicar no enter.

Charley Rocha · 29 de agosto de 2019

Eu entendi o que você falou e fiz um teste aqui que funcionou perfeitamente. Eu deixei uma célula com a fórmula =HOJE() e em outra célula digitei a data manualmente. Quando eu digito a data de hoje nessa outra célula os valores das duas células ficam iguais e a macro executa perfeitamente.

O que eu ainda não entendi é a necessidade dessa condicional:

If Target.Address = "$I$" & linha Then

Outra coisa: em qual objeto do VBA você está colando esse código? EstaPastaDeTrabalho, Planilha1, etc...?

EDIT: Segue anexo como exemplo.

datas.rar

PERDÃO!!! Só agora entendi (eu acho) o que você quer de fato!

Faz o seguinte: Faça uma outra sub e copie a sua macro do jeito do que está e cole lá.

Sub Workbook_Open()



End Sub

Ao abrir a planilha a macro deve ser executada.

Cândido Lorencini · 29 de agosto de 2019

Eu retirei esta condição (If Target.Address = "$I$" & linha Then)

Para mim funcionou também, porém, acredito que esteja de forma manual ainda.

O exemplo que você fez acho que está no modo manual.

Deixa esta macro para ser executada amanhã.

Ou seja, no campo que você digitou manualmente a data, informa 30/08/2019 e no outro campo deixa =Hoje().

Amanhã ao abrir a planilha, sem digitar nada, ela executará a macro e enviará o e-mail?

Charley Rocha · 29 de agosto de 2019

@candidofla Dá uma olhada na minha última edição da resposta anterior. Se você colocar essa mesma macro na Sub Workbook_open( ), amanhã quando você abrir a planilha os e-mails serão enviados.

Lembre-se que a "Workbook_open( )" deve estar no objeto "EstaPastaDeTrabalho" no editor do VBA

Caso queira testar, faça as duas células com =HOJE( ), salve e feche a planilha e torne a abrir.

Cândido Lorencini · 30 de agosto de 2019

Bom dia!

Fiz conforme informado, porém, não funcionou.

Segue o código e em anexo a planilha com o VBA:

Sub Workbook_Open()
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim OutApp As Object
    Dim OutMail As Object
    Dim texto As String
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    linha = Target.Row
            If Planilha6.Cells(linha, 11).Value = Planilha6.Cells(linha, 10).Value Then
            texto = "Prezado(a)" & "," & vbCrLf & vbCrLf & _
                    " A CND Estadual da " & Planilha6.Cells(linha, 1) & "," & " Filial " & Planilha6.Cells(linha, 2) & "," & " emitida em " & _
                    Planilha6.Cells(linha, 8) & "," & " está vencendo ou vencida." & _
                    vbCrLf & vbCrLf & " Favor providenciar a renovação." & vbCrLf & vbCrLf & _
                    "Atenciosamente." & vbCrLf & vbCrLf & _
                    "Regularidade Fiscal"
            
            With OutMail
                .To = "[email protected]"
                .CC = ""
                .BCC = ""
                .Subject = " CND Estadual vencendo/vencida - " & Planilha6.Cells(linha, 1) & "," & " Filial - " & Planilha6.Cells(linha, 2)
                .Body = texto
                .Send   'Utilize Send para enviar o email sem abrir o Outlook
            End With
        End If
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    
End Sub

End Sub

Com certeza fiz alguma coisa errada. Teria com montar o VBA na minha planilha (em anexo) com suas sugestões?

Desde já lhe agradeço.

CONTROLE CND'S.zip

Charley Rocha · 30 de agosto de 2019

Bom dia!

Você copiou o código de maneira errada dentro do objeto "EstaPastaDeTrabalho" do VBA. Deveria ter removido tanto a linha "Private Sub..." quanto o último "End Sub".

Você tem 2 caminhos para escolher:

1. Você busca ajuda no fórum toda vez que precisar e nós ajudamos na medida do possível. Você copia e cola as soluções e não aprende com isso.

2. Você busca ajuda no fórum toda vez que precisar e nós ajudamos na medida do possível. Você procura entender a solução apresentada e estuda por sua conta paralelamente e vai aprendendo cada vez mais ao ponto de daqui a pouco ser você a estar ajudando os outros.

Não é da minha conta o caminho que você vai escolher, mas eu digo por experiência própria que o segundo, além de ser mais gratificante, te valoriza como profissional e dá uma turbinada no seu currículo.

O código ficou assim:

Sub Workbook_Open()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim texto As String
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    linha = 4
    Do While Planilha6.Cells(linha, 11).Value <> ""
            If Planilha6.Cells(linha, 11).Value = Planilha6.Cells(linha, 10).Value Then
            texto = "Prezado(a)" & "," & vbCrLf & vbCrLf & _
                    " A CND Estadual da " & Planilha6.Cells(linha, 1) & "," & " Filial " & Planilha6.Cells(linha, 2) & "," & " emitida em " & _
                    Planilha6.Cells(linha, 8) & "," & " está vencendo ou vencida." & _
                    vbCrLf & vbCrLf & " Favor providenciar a renovação." & vbCrLf & vbCrLf & _
                    "Atenciosamente." & vbCrLf & vbCrLf & _
                    "Regularidade Fiscal"
            
            'Debug.Print linha
            With OutMail
                .To = "[email protected]"
                .CC = ""
                .BCC = ""
                .Subject = " CND Estadual vencendo/vencida - " & Planilha6.Cells(linha, 1) & "," & " Filial - " & Planilha6.Cells(linha, 2)
                .Body = texto
                .Send   'Utilize Send para enviar o email sem abrir o Outlook
            End With
            End If
            linha = linha + 1
            
    Loop
    
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Não pude testar colocando um e-mail real aqui pra ver se ele realmente envia. Mas testei a execução do loop do código e funciona.

Entendendo o código: A partir da linha 4, a macro vai varrer todas as linhas da sua planilha checando se a célula da coluna J é igual à da coluna K. Ele vai repetir isso até encontrar uma célula em branco. Quando isso acontecer, o loop para.

Cada vez que as células forem iguais ele dispara o e-mail com os critérios que você criou. Não mexi em nada disso.

Encontre a planilha em anexo.

Bons estudos e um abraço!

CONTROLE CND'S.rar

Cândido Lorencini · 30 de agosto de 2019

Obrigado por ajudar!

Estou tentando resolver a bastante tempo. Infelizmente não estou conseguindo, pois, esta macro seria um piloto a uma outra que estou trabalhando na Planilha de ações-Bovespa).

Tentei com a marco que você enviou, porém, o excel já abre com erro, conforme print anexo.

Inserir o e-mail real e o erro continuou.

Infelizmente continuarei a pedir ajuda ao Clube, pois, realmente não sei como resolver.

Obrigado uma vez mais!

CONTROLE CND'S.rar

Charley Rocha · 30 de agosto de 2019

Peço perdão se você me entendeu mal. Pedir ajuda nunca é um problema, e via de regra as pessoas desse fórum sempre têm prazer em ajudar. O que eu propus foi você não simplesmente copiar e colar as soluções aqui propostas, mas tentar entender qual foi o raciocínio para o seu próprio crescimento e aprendizado.

O problema que estava dando é que, uma vez que o 1º e-mail é enviado, o objeto Outmail deixa de existir, pois o Outlook fecha a janela de "novo e-mail" assim que ele é enviado. A solução foi colocar a linha "Set Outmail = ..." dentro do loop. Assim, para cada iteração ele cria um novo e-mail antes de tentar enviar. Teste por favor:

Sub Workbook_Open()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim texto As String
    
    Set OutApp = CreateObject("Outlook.Application")
    linha = 4
    Do While Planilha6.Cells(linha, 11).Value <> ""
            If Planilha6.Cells(linha, 11).Value = Planilha6.Cells(linha, 10).Value Then
            texto = "Prezado(a)" & "," & vbCrLf & vbCrLf & _
                    " A CND Estadual da " & Planilha6.Cells(linha, 1) & "," & " Filial " & Planilha6.Cells(linha, 2) & "," & " emitida em " & _
                    Planilha6.Cells(linha, 8) & "," & " está vencendo ou vencida." & _
                    vbCrLf & vbCrLf & " Favor providenciar a renovação." & vbCrLf & vbCrLf & _
                    "Atenciosamente." & vbCrLf & vbCrLf & _
                    "Regularidade Fiscal"
            
            'Debug.Print linha
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = "[email protected]"
                .CC = ""
                .BCC = ""
                .Subject = " CND Estadual vencendo/vencida - " & Planilha6.Cells(linha, 1) & "," & " Filial - " & Planilha6.Cells(linha, 2)
                .Body = texto
                .Send   'Utilize Send para enviar o email sem abrir o Outlook
            End With
            End If
            linha = linha + 1
            
    Loop
    
Set OutMail = Nothing
Set OutApp = Nothing

End Sub