Ir ao conteúdo
  • Comunicados

    • Gabriel Torres

      Seja um moderador do Clube do Hardware!   12-02-2016

      Prezados membros do Clube do Hardware, Está aberto o processo de seleção de novos moderadores para diversos setores ou áreas do Clube do Hardware. Os requisitos são:   Pelo menos 500 posts e um ano de cadastro; Boa frequência de participação; Ser respeitoso, cordial e educado com os demais membros; Ter bom nível de português; Ter razoável conhecimento da área em que pretende atuar; Saber trabalhar em equipe (com os moderadores, coordenadores e administradores).   Os interessados deverão enviar uma mensagem privada para o usuário @Equipe Clube do Hardware com o título "Candidato a moderador". A mensagem deverá conter respostas às perguntas abaixo:   Qual o seu nome completo? Qual sua data de nascimento? Qual sua formação/profissão? Já atuou como moderador em algo outro fórum, se sim, qual? De forma sucinta, explique o porquê de querer ser moderador do fórum e conte-nos um pouco sobre você.   OBS: Não se trata de função remunerada. Todos que fazem parte do staff são voluntários.
    • DiF

      Poste seus códigos corretamente!   21-05-2016

      Prezados membros do Fórum do Clube do Hardware, O Fórum oferece um recurso chamado CODE, onde o ícone no painel do editor é  <>     O uso deste recurso é  imprescindível para uma melhor leitura, manter a organização, diferenciar de texto comum e principalmente evitar que os compiladores e IDEs acusem erro ao colar um código copiado daqui. Portanto convido-lhes para ler as instruções de como usar este recurso CODE neste tópico:  
Felipe2791

Mudar ativação de código vba

Recommended Posts

Bom dia,

 

Tenho o código VBA abaixo, uso ele a um tempo. 

Como podem ver ele envia uma mensagem com conteudo de uma respectiva linha no Excel, a ativação é marcando um "x".

Estou tentando mudar a ativação do codigo, preciso que o email seja enviado com um botão, para que fiquei em massa.

Ou seja, tenho 100 linhas, se as 100 estiverem marcada com o "x" ao ativar o botão os emails sejam disparados juntos. Não precisa ser exatamene com x marcado, pode ser outro mecanismo, com tanto que a ação seja 1 só para todas as linhas.

 

Desde já obrigado!

 

EDIT: ADICIONEI A PLANILHA TESTE

 

 

 

Citação

Sub Worksheet_Change(ByVal Target As Range)

'Envia e-mail pelo Outlook

    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 = "$A$" & linha Then
    If Plan1.Cells(linha, 1) = "x" Then

        With OutMail
            .To = Plan1.Cells(linha, 4)
            .CC = ""
            .BCC = ""
            .Subject = "Nível"
            .Body = "Prezado(a) " & Plan1.Cells(linha, 3) & "," & vbCrLf & vbCrLf & _
                    "Segue acompanhamento do mês de Julho."
                    
                    
            .Display    'Send para enviar o email sem abrir o Outlook
        End With
        On Error GoTo 0
        End If

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

 

 

teste.rar

Editado por Felipe2791

Compartilhar este post


Link para o post
Compartilhar em outros sites

@Felipe2791 A ativação do script está ocorrendo quando há uma mudança na planilha(Worksheet_change):

Sub Worksheet_Change(ByVal Target As Range)

Você tem que trocar para um evento de clique de botão.

 

No código atual, ele envia um email checando mudanças e enviando o email com os dados somente daquela linha modificada:

 

linha = ActiveCell.Row - 1
If Target.Address = "$A$" & linha Then
If Plan1.Cells(linha, 1) = "x" Then

Você teria que fazer também um FOR, para checar todas as linhas e rodar a parte do script que envia o email para cada uma delas.

 

Estou sem o Office aqui, mas acho que com os links ai dá pra resolver.

 

 

 

 

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie um loop para verificar se a celula esta preenchida e pronto

 

Troque o nome da macro para sub enviar.

 

Depois crie uma outra macro assim

 

Sub EnvioMassa()

 

Suponha que você coloque o X na Coluna B e os emails na Coluna A (Nao vi seu arquivo)

 

Range ("A2).select

 

Do While Activecell <> "" 

 

if activecell.offset(0,1).value = "X" then

 

Enviar

 

Else

 

activecell.offset(1,0).select

 

 

end if

 

 

Loop

 

End Sub

 

Em resumo essa segunda macro vai verificar se na coluna B posssui um X se sim vai executar a macro enviar se nao pula uma linha para que possa verificar a proxima.

 

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites
  • Autor do tópico
  • Bom dia,

     

    Obrigado aos 2 que responderam.  @CasaDoHardware - @darkstrikerd

    Tentei das dua manieiras e sem sucesso, acho que estou errando em algum detalhe, tenho algumas planilhas com alguns VBAs, mas o maximo que faço é modifica-los em detalhes da maneira que preciso.

     

    Podem clarear ainda mais para mim?

     

    EDIT: no caso da segunda resposta o Range ("A2).select não funciona no código.

    Editado por Felipe2791

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Cometi um pequeno erro

     

    Deveria ser assim

     

    Range("A2").select 

     

    Mas ja ajustei a macro a sua planilha é so copiar os codigos do modulo 1 e colar em um modulo de sua planilha original.

    teste.xlsm

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • 9 minutos atrás, CasaDoHardware disse:

    Cometi um pequeno erro

     

    Deveria ser assim

     

    Range("A2").select 

     

    Mas ja ajustei a macro a sua planilha é so copiar os codigos do modulo 1 e colar em um modulo de sua planilha original.

    teste.xlsm

    @CasaDoHardware

    Esta retornando um erro no If Target.Address = "$A$" & linha Then do primeiro Script.

    Tentei trocar algumas coisas, mas se colocarmos o X maiusculo o erro retorna, se coloco o minusculo faz a varredura mas não gera o email.

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Nesta Linha

     

    if activecell.offset(0,1).value = "X" then

     

    troque o X Maiusculo por x minusculo que vai funcionar

     

     

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • 19 minutos atrás, CasaDoHardware disse:

    Cometi um pequeno erro

     

    Deveria ser assim

     

    Range("A2").select 

     

    Mas ja ajustei a macro a sua planilha é so copiar os codigos do modulo 1 e colar em um modulo de sua planilha original.

    teste.xlsm

    @CasaDoHardware

    Eu fiz isso da outraz vez tambem, dessa maneira a varredura funciona.

    Mas o email não é gerado no Display.

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    @Felipe2791Segue em anexo com as adaptaçoes para voce testaar. 

    Não testei pois nao tenho o outlook habilitado. 

     

    * Só um detalhe dependendo do servidor de email (por exemplo o Gmail), nao vai 'deixar' voce enviar emails em massa. 

    Pelo menos para mim aconteceu. Tenten a algum tempo atras, enviar emails 'por atacado' e o Gmail me bloqueou alegando spam. 

     

     

     

     

    teste-Basole.xlsm

    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • 8 minutos atrás, Basole disse:

    @Felipe2791Segue em anexo com as adaptaçoes para voce testaar. 

    Não testei pois nao tenho o outlook habilitado. 

     

    * Só um detalhe dependendo do servidor de email (por exemplo o Gmail), nao vai 'deixar' voce enviar emails em massa. 

    Pelo menos para mim aconteceu. Tenten a algum tempo atras, enviar emails 'por atacado' e o Gmail me bloqueou alegando spam. 

     

     

     

     

    teste-Basole.xlsm

     

    @Basole Não vou ter esse problema, o servidor é particular.

    Um detalhe, o codigo está repetindo somente o primeiro email, não percorre a planilha. voce pode comprovar o problema porque o texto "nome 1..." aparece em todos emails aberto.

     

     

    Editado por Felipe2791

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Desculpe acrescente esta linha agentes da linha loop

    Linha = linha + 1

    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • 7 minutos atrás, Basole disse:

    Desculpe acrescente esta linha agentes da linha loop

    Linha = linha + 1

    @Basole Adicionei, ele envia 2 em sequencia e para.

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • 39 minutos atrás, Basole disse:

    Desculpe, acho que me equivoquei na orientacao acima.

     

    Segue em anexo c/ as alteraçoes

     

    teste-Basole-v1.xlsm

    @Basole Para minha necessidade vai funcionar muito, mas tem um detalhe, quando ele encontra um problema (linha sem X) ele para e não "pula" para a proxima com X.

     

    Eu vou usar a lista toda sempre, então tá tranquilo.

     

    EDIT: Pensando bem, se tivesse como resolver esse problema eu agradeceria, pode ser que eu use.

    Editado por Felipe2791

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    você testou a alteração que postei????

    Nesta Linha

     

    if activecell.offset(0,1).value = "X" then

     

    troque o X Maiusculo por x minusculo que vai funcionar

     

    Editado por CasaDoHardware

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • 14 minutos atrás, CasaDoHardware disse:

    você testou a alteração que postei????

    Nesta Linha

     

    if activecell.offset(0,1).value = "X" then

     

    troque o X Maiusculo por x minusculo que vai funcionar

     

    Testei sim, não pasou, ele faz a varredura mas não dispara email

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Digite x na celula A7 e faça o seguinte:

     

    Abra o Editor VBA 

     

    No codigo enviomassa depure o codigo e siga passo a passo ate a finalizar e diga se apresenta algum erro

     

    Eu nao tenho como testar mas se seu codigo funciona tem que funcionar dessa forma porque quando você coloca x em A7 (serve qualquer celula da coluna A), ele aceita o if que criei como verdadeiro e executa a macro enviar que alterei o nome da sua para enviar.

     

    você fez essa alteração na Planilha original trocou o nome da sua macro para enviar e colou ela em um modulo?

     

    Veja que essa codigo faz somente isso 

     

    Ele seleciona a coluna D e enquanto a coluna D nao estiver Vazia ele vai rodar 

    O teste if verifica se a celula da coluna A tem um x se tiver executa a macro Enviar (sua macro com novo nome que deve se copiada e colada em um modulo), se nao existir um x na linha da coluna A ele simplesmente pula para a proxima, ate encontrar uma linha vazia na coluna D.

     

     

     

     

    Sub EnvioMassa()
     

    'Seleciona a primeira celula com email da coluna D 
    Range("D7").Select
     

    'Enquanto a nao encontrar uma celula Vazia na coluna D executa o que vem a seguir
    Do While ActiveCell <> ""
     

    Se a celula da linha ativa na coluna A existir um x
    If ActiveCell.Offset(0, -3).Value = "x" Then
     

    'Executa a macro Enviar (sua macro acima com o nome Private Sub Enviar () que esta no modulo com o arquivo que enviei)
    Enviar
     Se nao
    Else
     Pula uma linha
    ActiveCell.Offset(1, 0).Select
     
     
    End If
     
     Reinicia o codigo 
    Loop
     
    End Sub

     

    então se você fez isso tudo conforme esta acima tem que funcionar.

    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • 16 minutos atrás, CasaDoHardware disse:

    Digite x na celula A7 e faça o seguinte:

     

    Abra o Editor VBA 

     

    No codigo enviomassa depure o codigo e siga passo a passo ate a finalizar e diga se apresenta algum erro

     

    Eu nao tenho como testar mas se seu codigo funciona tem que funcionar dessa forma porque quando você coloca x em A7 (serve qualquer celula da coluna A), ele aceita o if que criei como verdadeiro e executa a macro enviar que alterei o nome da sua para enviar.

     

    você fez essa alteração na Planilha original trocou o nome da sua macro para enviar e colou ela em um modulo?

     

    Veja que essa codigo faz somente isso 

     

    Ele seleciona a coluna D e enquanto a coluna D nao estiver Vazia ele vai rodar 

    O teste if verifica se a celula da coluna A tem um x se tiver executa a macro Enviar (sua macro com novo nome que deve se copiada e colada em um modulo), se nao existir um x na linha da coluna A ele simplesmente pula para a proxima, ate encontrar uma linha vazia na coluna D.

     

     

     

     

    Sub EnvioMassa()
     

    'Seleciona a primeira celula com email da coluna D 
    Range("D7").Select
     

    'Enquanto a nao encontrar uma celula Vazia na coluna D executa o que vem a seguir
    Do While ActiveCell <> ""
     

    Se a celula da linha ativa na coluna A existir um x
    If ActiveCell.Offset(0, -3).Value = "x" Then
     

    'Executa a macro Enviar (sua macro acima com o nome Private Sub Enviar () que esta no modulo com o arquivo que enviei)
    Enviar
     Se nao
    Else
     Pula uma linha
    ActiveCell.Offset(1, 0).Select
     
     
    End If
     
     Reinicia o codigo 
    Loop
     
    End Sub

     

    então se você fez isso tudo conforme esta acima tem que funcionar.

    Eu tenteide tudo botar para funcionar, mas ele retornar a depuração no meu VBA, na linha: If Target.Address = "$A$" & linha Then

     

     

     

    Private Sub Enviar()

    'Envia e-mail pelo Outlook

        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 = "$A$" & linha Then
        If Plan1.Cells(linha, 1) = "x" Then

            With OutMail
                .To = Plan1.Cells(linha, 4)
                .CC = ""
                .BCC = ""
                .Subject = "Nível"
                .Body = "Prezado(a) " & Plan1.Cells(linha, 3) & "," & vbCrLf & vbCrLf & _
                        "Segue acompanhamento do mês de Julho."
                        
                        
                .Display    'Send para enviar o email sem abrir o Outlook
            End With
            On Error GoTo 0
            End If

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

    Editado por Felipe2791

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

     

     

    Tente apagar essa linha do erro e o ultimo end if que esta acima  do end sub

    Editado por CasaDoHardware

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • 8 minutos atrás, CasaDoHardware disse:

     

     

    Tente apagar essa linha do erro e o ultimo end if que esta acima  do end sub

    ela fica carregando (mesmo com 3 linhas ativas e 1 x) quando aperto ESC ele pede para depurar a linha seguinte.

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    O error aparece por causa do Target

    Tente declarar o objeto desta forma:

    Dim Target as range
    

     

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • Em 21/03/2016 às 17:14, Basole disse:

    O error aparece por causa do Target

    Tente declarar o objeto desta forma:

    
    Dim Target as range
    

     

    @Basole Mesma coisa, Quando coloco o X apenas na segunda ele trava o Excel, se coloco nas 3 primeiras e pulo pra quinta, ele para de enviar na terceira.

     

    Já tentei mas não consegui. 

     

    Citação

    Na verdade tem que apagar essa variavel

     

    Apague essa linha tb

    @CasaDoHardware O seu codigo não consegui colocar para funcionar de forma alguma, a parte dos rastreio da condição está perfeita, mas os emails não disparam, já eliminei tudo que pediu.

    Editado por Felipe2791

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • 8 minutos atrás, Basole disse:

    Bom dia,

    Felipe segue em anexo com as correções: 

    teste-Basole-v2.xlsm

     

    @BasoleApareceu depuração na linha que indica o endereço de email:

     

    .To = Plan1.Cells(linha, 4)

    Editado por Felipe2791

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Crie uma conta ou entre para comentar

    Você precisar ser um membro para fazer um comentário






    Sobre o Clube do Hardware

    No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

    Direitos autorais

    Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

    ×