Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
MsgBox editavel
 
Notifications
Clear all

MsgBox editavel

 
2024 - VBA & Macros
Post Recente por fazerbem 8 anos atrás
12 Posts
3 Usuários
0 Reactions
1,491 Visualizações
RSS
 fazerbem
(@fazerbem)
Posts: 0
New Member
Topic starter
 

Queria uma rotina em que aparecesse uma mensagem MsgBox, iria aparecer, digite o email , ai entao eu digito o email, este será escrito na celula c1, e entao minha macro prosseguira normailmente e pegara quando solicitada o conteudo de c1.
Detalhe: não quero fazer por useform, pois minha planilha não usa useform.

Grato

 
Postado : 29/06/2016 6:00 pm
 Basole
(@basole)
Posts: 487
Reputable Member
 

Tente algo assim..

Sub Test_Msg_Email()
Dim m_Email As String
m_Email = InputBox("Digite o Email", "Cadastro de Email", "seu_e-mail@gmail.com")
[c1].Value = m_Email
End Sub
 
Postado : 29/06/2016 6:22 pm
 fazerbem
(@fazerbem)
Posts: 0
New Member
Topic starter
 

Tente algo assim..

Sub Test_Msg_Email()
Dim m_Email As String
m_Email = InputBox("Digite o Email", "Cadastro de Email", "seu_e-mail@gmail.com")
[c1].Value = m_Email
End Sub

Ja testei aqui e era exato o que eu queria, mas te pergunto, e como faço pra manter na mesma MsgBox mais um campo Digite o Assunto ? sem ter que criar outra MsgBox ?

Digite o Email e o Assunto

[email protected]
Assunto: xxxxxxxxxxxxxxxx

Ok Cancela

Ao digitar o assunto este segue o mesmo procedimento do Email e cola na Celula A2

Grato

Andre

 
Postado : 30/06/2016 11:22 am
 Basole
(@basole)
Posts: 487
Reputable Member
 

Só usando 2 inputbox ou userform
Até poderia usar 1 inputbox para o usuario inserir o email a virguala (para separar as informaçoes, por exemplo) e o assunto, mas se ele nao seguir esta regra as inf. nas celulas que receberão vão vicar incorretas.

 
Postado : 30/06/2016 11:37 am
 fazerbem
(@fazerbem)
Posts: 0
New Member
Topic starter
 

Só usando 2 inputbox ou userform
Até poderia usar 1 inputbox para o usuario inserir o email a virguala (para separar as informaçoes, por exemplo) e o assunto, mas se ele nao seguir esta regra as inf. nas celulas que receberão vão vicar incorretas.

Fiz assim até deu , mas como vc citou, eu queria na mesma janela ter as duas informacoes .

Teria como vc acertar, vc disse pra separar por virgula mas nao entendi bem.

Dim m_Email As String
Dim m_Assu As String
m_Email = InputBox("Digite o Email", "Cadastro de Email", "")
m_Assu = InputBox("Digite o Assunto", "Cadastro de Email", "")
Range("B32").Value = m_Email
Range("B44").Value = m_Assu

 
Postado : 30/06/2016 1:52 pm
 fazerbem
(@fazerbem)
Posts: 0
New Member
Topic starter
 

Se nao der daria pra me fornecer uma macro que abrisse entao um formulario contendo:

inserir o email - xxxxxxxxxxxx
inserir o assunto - yyyyyyyyyyy

botao Ok

Email direciona a celula B32
Assunto direciona a celula B40

Grato.

 
Postado : 30/06/2016 2:40 pm
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

E por isso que o ideal é disponibilizar o arquivo com informações

Facilita quem vai ajudar

 
Postado : 30/06/2016 2:45 pm
 Basole
(@basole)
Posts: 487
Reputable Member
 

Faça o teste na opcao que falei com a virgula, com unico inputbox

Dim m_Email As String

m_Email = InputBox("Digite o Email a (,)Virgula e o Assunto", "Cadastro de Email", "")

If m_Email = "" Then Exit Sub

ActiveSheet.Range("B32").Value = Left(m_Email, InStr(m_Email, ",") - 1)
ActiveSheet.Range("B44").Value = Right(m_Email, Len(m_Email) - InStr(m_Email, ","))
 
Postado : 30/06/2016 2:52 pm
 fazerbem
(@fazerbem)
Posts: 0
New Member
Topic starter
 

deu certinho colocando a virgula, a titulo de curiosidade, como ficaria atraves de uma useform ?

Inserir o Email - caixa de texto ( xxxxxxx )
Inserir o Assunto - caixa de texto ( zzzz )

Botao OK segue a macro
Botao Cancelar termina a Macro

Dai eu aprendo e adapto aqui na minha macro, favor nao rir, esta bagunçado, sei disso , mas ta tudo funcionando rsrsrsr.
Nem quero arrumar pois time que ta ganhando nao sse mexe, e da forma que esta abaixo, eu me acho direitinho.

Sub A1_Envio_Individual()
    '======================================
    ' Preparando o E-mail para ser enviado
    '======================================
 
  Application.ScreenUpdating = 0 'Deixa a macro mais rápida (Desliga a tela de atualização)
 
If Range("C10").Value = 2 And Range("D16").Value = "" Or Range("C10").Value = 3 And Range("D17").Value = "" Then
MsgBox ("REVEJA SEUS ANEXOS !")
GoTo Email
Else: End If
If Range("C10").Value = 2 And Range("F16").Value = "" Or Range("C10").Value = 3 And Range("F17").Value = "" Then
MsgBox ("REVEJA SEUS ANEXOS !")
GoTo Email
Else: End If
If Range("C10").Value = 2 And Range("H16").Value = "" Or Range("C10").Value = 3 And Range("H17").Value = "" Then
MsgBox ("REVEJA SEUS ANEXOS !")
GoTo Email
Else: End If
 
If Range("A6").Value = 6 Then
MsgBox ("ESCOLHER UMA CONTA DE EMAIL !!!")
GoTo Email
Else: End If

If Range("A14").Value = 4 Then
MsgBox ("ESCOLHER UM FABRICANTE !!!")
GoTo Email
Else: End If

If Range("A19").Value = 11 Then
MsgBox ("ESCOLHER UMA REVENDA !!!")
GoTo Email
Else: End If
 
 Dim Revenda As String
 Revenda = Range("B31")  'Aqui aparece o Nome da Revenda a ser ativada ex Aba Mundo Verde
 
' Loop Avisos Importantes
If Range("C8").Value = 2 Then

GoTo Avisos
Else
End If

If Range("C8").Value = 3 Then

GoTo Avisos
Else
End If
 
If Range("A19").Value = 9 Then

     Sheets(Revenda).Visible = True
     Sheets("EN2").Visible = True
     Sheets(Revenda).Select


GoTo Diversas_Lojas
GoTo Diversas
Diversas:
Else: End If
 
If Range("A19").Value = 9 Then
GoTo A
Else: End If

If Sheets("CONFIG").Range("A3").Value = 2 Then  ' (D20)= Ativar Individual
GoTo Terminar
Else
End If
 
 GoTo Volte
Volte:
  
' Dim Revenda As String
' Revenda = Range("D25")  'Aqui aparece o Nome da Revenda a ser ativada ex Aba Mundo Verde
 
 If Range("A19").Value = 11 Then 'Seleciona a Revenda
 GoTo Terminar
 Else
      End If

GoTo Avisos
Avisos:

If Range("B31").Value = "Convites" Then
GoTo A
Else
End If

 If Range("B31").Value > 0 Then
     Sheets(Revenda).Visible = True  'ATIVE A REVENDA
 '    Sheets("EN").Visible = True
     
GoTo A
A:

If Range("A19").Value = 10 Then

Dim m_Email As String
Dim m_Assu As String
m_Email = InputBox("Digite o Email", "Cadastro de Email", "")
m_Assu = InputBox("Digite o Assunto", "Cadastro de Email", "")
Range("B32").Value = m_Email
Range("B40").Value = m_Assu
GoTo Diversas_Lojas

Else
End If

     Sheets(Revenda).Select
  
  Else
       End If
   
 If Range("Q4").Value = "" Or Range("K4").Value = "4" Or Range("S7").Value = "" Or Range("K4").Value = "" Then
 MsgBox ("Fabricante ou Conta de E-mail ou Anexo nao informado !!")
 
 GoTo Terminar
 
 Else
 End If
    
If Range("A1").Value = "Enviar Convites" Then
    
GoTo EN2
Else: End If
    
GoTo Diversas_Lojas
Diversas_Lojas:
'---------------------------------------------------
'PROPAGANDAS

If Sheets("Config").Range("C8").Value = 3 Then
    Dim mainWB As Workbook
 '   Dim olMail As MailItem
Dim strbody As String
        
'Set olMail = otlApp.CreateItem(olMailItem)
'Set Doc = olMail.GetInspector.WordEditor
Dim oAttach As Outlook.Attachment

Set mainWB = ActiveWorkbook

Else
End If

'--------------------------------------------------
    Dim olapp As Outlook.Application
    Dim OlMensagem As Outlook.MailItem
    Dim Leitura     As String
    Dim contaEmail As String
    Dim Loja        As String
    Dim Estado    As String
    Dim Pasta As String
    Dim Arquivo As String
    Dim i As Long
    Dim UltimaLinha As Long
    Dim Mensagem As String
    Dim Assunto     As String

If Range("A19").Value = 10 Then

'Dim m_Assunto As String
'm_Assunto = InputBox("Digite o Assunto", "Cadastro do Assunto", "")
'Range("B40").Value = m_Assunto

' Preste atencao aqui
      contaEmail = ThisWorkbook.Sheets("Config").Range("B42").Value 'Valido somente se Convites estiver marcado
      
GoTo m_Assunto
Else
End If

 If Sheets("Config").Range("C8").Value = 4 Then
 Assunto = "Trago uma novidade !"
 Else: End If
    
 If Sheets("Config").Range("C8").Value = 3 Then
 Assunto = "Visite nosso Site."
 Else: End If
 
  If Sheets("Config").Range("C8").Value = 2 Then
 Assunto = "Avisos"
 Else: End If
 
   If Sheets("Config").Range("C8").Value = 1 Then
 Assunto = Range("L1")
 Else: End If
 
   If Sheets("Config").Range("C8").Value = 5 Then
 Assunto = "Apresentação LEADER NUTRITION"
 
 Else: End If
 
    Estado = Range("H10")
    Loja = Range("A1")
    
    Leitura = Sheets(Loja).Range("I7")


  Sheets("Envios Individuais").Visible = True
' Sheets("Config").Select
' GoTo Diversas
 '--------------------------------------------------------------

GoTo EN2
EN2:

If Range("A1").Value = "Enviar Convites" Then

Sheets("EN2").Select


If Sheets("CONFIG").Range("B35").Value = 1 Then
    Range("A2:A500").Select
    Else
If Sheets("CONFIG").Range("B35").Value = 2 Then
    Range("C2:C500").Select
    Else
If Sheets("CONFIG").Range("B35").Value = 3 Then
    Range("E2:E500").Select
    Else

    End If
    End If
    End If

    Selection.Copy
    Sheets("Envios Individuais").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets("Enviar Convites").Select

GoTo EN2_SEGUE

Else
End If

If Range("A1").Value = "DVitaminas" Or Range("A1").Value = "Academias" Or Range("A1").Value = "SNC" Or Range("A1").Value = "Rio de Janeiro" Or Range("A1").Value = "Farmacias" Then

    Range("C2:C100").Select
    Selection.Copy
    Sheets("Envios Individuais").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
               
GoTo Segue

Else

 Sheets(Estado).Visible = True
 Sheets(Estado).Select
    Range("C1:C100").Select
    Selection.Copy
    Sheets("Envios Individuais").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Sheets(Loja).Select
        
If Range("H10").Value = "RJ" Or Range("H10").Value = "SP" Then

Sheets(Estado).Select
    Range("G1:G100").Select
    Selection.Copy
    Sheets("Envios Individuais").Select
    Range("C103").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Else
End If
        
 Sheets(Estado).Visible = False
       
Sheets("Envios Individuais").Select
Range("A5").Select

End If


GoTo Segue
Segue:

GoTo EN2_SEGUE

 Sheets(Loja).Select
 
EN2_SEGUE:
 Sheets("Config").Select
 If Sheets("Config").Range("A14").Value = 1 Then
    Range("D62").Select
 Else: End If
 
 If Sheets("Config").Range("A14").Value = 2 Then
    Range("F62").Select
 Else: End If
 
  If Sheets("Config").Range("A14").Value = 3 Then
    Range("H62").Select
 Else: End If

    Selection.Copy
    Sheets("Envios Individuais").Select
    Range("Q1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
  
 Sheets(Loja).Select
    Range("Q6").Select
    Selection.Copy
    Sheets("Envios Individuais").Select
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
 Sheets(Loja).Select
    Range("I6").Select
    Selection.Copy
    Sheets("Envios Individuais").Select
    Range("A23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
 Sheets(Loja).Select
    Range("K4").Select
    Selection.Copy
    Sheets("Envios Individuais").Select
    Range("B12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    
' Preste atencao aqui
      contaEmail = ThisWorkbook.Sheets("Envios Individuais").Range("A5").Value
      
GoTo m_Assunto
m_Assunto:
    
  ' Create the Outlook application and the empty email.
    Set olapp = CreateObject("Outlook.Application")
    Set OlMensagem = olapp.CreateItem(0)
'    Set Doc = OlMensagem.GetInspector.WordEditor
         
   'Este laço verifica se o nome da conta w no registro do windows é igual ao valor da célula
    For W = 1 To olapp.Session.Accounts.Count
       '  For w = 1 To Correio.Session.Accounts.Count
    

    
        If olapp.Session.Accounts.Item(W).DisplayName = contaEmail Then 'Se for verdadeiro, solicita confirmação
        
      If Sheets("CONFIG").Range("C9").Value = 2 Then 'Se Envio de todos UF
        
            If MsgBox("O E-mail será enviado usando a conta " & contaEmail & ". Confirma ?", vbQuestion + vbYesNo, "Envio de e-mail") = vbYes Then
                            
  Else
  
  GoTo Fim
  
  
  
  End If
  End If
                idEmail = W 'Define o id da conta para o comando enviar
                Exit For 'Sai do laço
                
  
                    
       
        End If
    Next
       
       UltimaLinha = Sheets("Envios Individuais").Cells(Cells.Rows.Count, 3).End(xlUp).Row
    If UltimaLinha < 3 Then UltimaLinha = 3
           
    'Laço para pegar cada um dos destinatários da coluna B, começando na linha 3
    For i = 3 To UltimaLinha
    
  ' Create the Outlook application and the empty email.
    Set olapp = CreateObject("Outlook.Application")
    Set OlMensagem = olapp.CreateItem(0)

    
  'Using the email, add multiple recipients, using a list of addresses in column C.
     With OlMensagem
     
         'Campo Assunto
If Sheets("Config").Range("A19").Value = 10 Then

        .Subject = Sheets("Config").Range("B40").Value
Else

        .Subject = Assunto
        'Cria a mensagem que será enviada
End If
'--------------------------------------------
'PROPAGANDAS
If Sheets("Config").Range("C8").Value = 3 Then

 GoTo Propaganda
 Else
 End If
'-----------------------------------------------------------

 If Sheets("Config").Range("C8").Value = 1 And Sheets("Config").Range("A14").Value = 1 Then
 
        Mensagem = Mensagem & Sheets("Config").Range("D25").Value & Chr(10) & Chr(10)

        Mensagem = Mensagem & Sheets("Config").Range("D27").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D31").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D35").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D39").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D43").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente" & Chr(10) & Chr(10)
        Mensagem = Mensagem & "André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)

 GoTo Aviso2
 
 Else
 End If
 
 If Sheets("Config").Range("C8").Value = 1 And Sheets("Config").Range("A14").Value = 2 Then
 
        Mensagem = Mensagem & Sheets("Config").Range("F25").Value & Chr(10) & Chr(10)

        Mensagem = Mensagem & Sheets("Config").Range("F27").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F31").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F35").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F39").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F43").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente" & Chr(10) & Chr(10)
        Mensagem = Mensagem & "André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)


 GoTo Aviso2
 
 Else
 End If
        
 If Sheets("Config").Range("C8").Value = 1 And Sheets("Config").Range("A14").Value = 3 Then
 
        Mensagem = Mensagem & Sheets("Config").Range("H25").Value & Chr(10) & Chr(10)

        Mensagem = Mensagem & Sheets("Config").Range("H27").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H31").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H35").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H39").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H43").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente" & Chr(10) & Chr(10)
        Mensagem = Mensagem & "André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)

 GoTo Aviso2
 
 Else
 End If
 
  If Sheets("Config").Range("C8").Value = 2 And Sheets("Config").Range("A14").Value = 1 Then
 
        Mensagem = Mensagem & Sheets("Config").Range("D25").Value & Chr(10) & Chr(10)

        Mensagem = Mensagem & Sheets("Config").Range("D27").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D31").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D35").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D39").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D43").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente" & Chr(10) & Chr(10)
        Mensagem = Mensagem & "André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)
        
 GoTo Aviso2
 
 Else
 End If
 
   If Sheets("Config").Range("C8").Value = 2 And Sheets("Config").Range("A14").Value = 2 Then
 
        Mensagem = Mensagem & Sheets("Config").Range("F25").Value & Chr(10) & Chr(10)

        Mensagem = Mensagem & Sheets("Config").Range("F27").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F31").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F35").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F39").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F43").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente" & Chr(10) & Chr(10)
        Mensagem = Mensagem & "André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)

 GoTo Aviso2
 
 Else
 End If
 
   If Sheets("Config").Range("C8").Value = 2 And Sheets("Config").Range("A14").Value = 3 Then
 
        Mensagem = Mensagem & Sheets("Config").Range("H25").Value & Chr(10) & Chr(10)

        Mensagem = Mensagem & Sheets("Config").Range("H27").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H31").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H35").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H39").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H43").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente" & Chr(10) & Chr(10)
        Mensagem = Mensagem & "André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)

 GoTo Aviso2
 
 Else
 End If
        
'-----------------------------------------
'PROPAGANDA
'----------------------------
GoTo Propaganda
Propaganda:
'-----------------------------
 
 If Sheets("Config").Range("C8").Value = 3 And Sheets("Config").Range("A14").Value = 1 Then
             
'        Mensagem = Mensagem & Sheets("Config").Range("D25").Value & Chr(10) & Chr(10)

        Mensagem = Mensagem & Sheets("Config").Range("D27").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D31").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D35").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D39").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D43").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente" & Chr(10) & Chr(10)
        Mensagem = Mensagem & "André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)

 Else
 End If
 
  If Sheets("Config").Range("C8").Value = 3 And Sheets("Config").Range("A14").Value = 2 Then
               
 '       Mensagem = Mensagem & Sheets("Config").Range("F25").Value & Chr(10) & Chr(10)

        Mensagem = Mensagem & Sheets("Config").Range("F27").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F31").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F35").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F39").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F43").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente" & Chr(10) & Chr(10)
        Mensagem = Mensagem & "André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)
 
 Else
 End If
 
  If Sheets("Config").Range("C8").Value = 3 And Sheets("Config").Range("A14").Value = 3 Then
               
  '      Mensagem = Mensagem & Sheets("Config").Range("H25").Value & Chr(10) & Chr(10)

        Mensagem = Mensagem & Sheets("Config").Range("H27").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H31").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H35").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H39").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H43").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente" & Chr(10) & Chr(10)
        Mensagem = Mensagem & "André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)
 
 Else
 End If
 
  If Sheets("Config").Range("C8").Value = 4 And Sheets("Config").Range("A14").Value = 1 Then
 
        Mensagem = Mensagem & Sheets("Config").Range("D27").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D31").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D35").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("D39").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente, André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)
 Else
 End If
 
  If Sheets("Config").Range("C8").Value = 4 And Sheets("Config").Range("A14").Value = 2 Then
               
        Mensagem = Mensagem & Sheets("Config").Range("F27").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F31").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F35").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("F39").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente, André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)
 Else
 End If
 
  If Sheets("Config").Range("C8").Value = 4 And Sheets("Config").Range("A14").Value = 3 Then
               
        Mensagem = Mensagem & Sheets("Config").Range("H27").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H31").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H35").Value & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("H39").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente, André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)
 
 Else
 End If
 
   If Sheets("Config").Range("C8").Value = 5 And Sheets("Config").Range("A14").Value = 2 Then
               
        Mensagem = Mensagem & Sheets("Config").Range("N2").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("N4").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("N6").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("N9").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("N16").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("N20").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("N23").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("N33").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & Sheets("Config").Range("N35").Value & Chr(10) & Chr(10)
        Mensagem = Mensagem & "Atenciosamente, André Luiz" & Chr(10)
        Mensagem = Mensagem & "Comercial RJ" & Chr(10) & Chr(10)
 
 Else
 End If
 
'---------------------------------------------

GoTo Aviso2
Aviso2:

         'A Mensagem que seguirá no corpo do e-mail
         .Body = Mensagem
                 
         'Para quem vai a mensagem...
If Sheets("Config").Range("A19").Value = 10 Then
         .To = Sheets("Config").Range("B32").Value
 Else
         .To = Range("C" & i).Value
 End If
         
         'Se for enviar com cópia
         'EMail.Cc = "dantas.mariana@emrpesa.com"
         
If Sheets("Config").Range("C8").Value = 4 Then
GoTo Enviar_Sem_Anexo
Else: End If
         
         'Arquivos a serem anexados
 If Sheets("Config").Range("A14").Value = 1 And Sheets("Config").Range("C10").Value = 1 Then
         .Attachments.Add Sheets("Config").Range("D15").Value
  Else: End If
  
 If Sheets("Config").Range("A14").Value = 2 And Sheets("Config").Range("C10").Value = 1 Then
         .Attachments.Add Sheets("Config").Range("F15").Value
  Else: End If
     
 If Sheets("Config").Range("A14").Value = 3 And Sheets("Config").Range("C10").Value = 1 Then
         .Attachments.Add Sheets("Config").Range("H15").Value
  Else: End If
     
     '  EMail.Attachments.Add "C:UsersAndreDesktopPedidos GauerCatalogo Leader Nutrition.pdf"
         
If Sheets("CONFIG").Range("C10").Value = 3 And Sheets("CONFIG").Range("A14").Value = 1 Then
         .Attachments.Add Range("A2").Value & Range("A26").Value
         .Attachments.Add Range("A2").Value & Range("A27").Value
Else: End If

If Sheets("CONFIG").Range("C10").Value = 2 And Sheets("CONFIG").Range("A14").Value = 1 Then
         .Attachments.Add Range("A2").Value & Range("A26").Value
Else: End If

         
If Sheets("CONFIG").Range("C10").Value = 3 And Sheets("CONFIG").Range("A14").Value = 2 Then
         .Attachments.Add Range("A2").Value & Range("A31").Value
         .Attachments.Add Range("A2").Value & Range("A32").Value
Else: End If

If Sheets("CONFIG").Range("C10").Value = 2 And Sheets("CONFIG").Range("A14").Value = 2 Then
         .Attachments.Add Range("A2").Value & Range("A31").Value
Else: End If

GoTo Enviar_Sem_Anexo
Enviar_Sem_Anexo:

'------------------------------------------------
'PROPAGANDAS

If Sheets("Config").Range("C8").Value = 3 And Sheets("Config").Range("A14").Value = 1 Or Sheets("Config").Range("A14").Value = 1 Or Sheets("Config").Range("A14").Value = 2 Or Sheets("Config").Range("A14").Value = 3 Then

If Sheets("Config").Range("A14").Value = 2 Then

If Sheets("Config").Range("F21").Value > 0 Then
    .Attachments.Add Sheets("Config").Range("F21").Value, olByValue, 0
Else: End If
    
If Sheets("Config").Range("F20").Value > 0 Then
    .Attachments.Add Sheets("Config").Range("F20").Value, olByValue, 0
Else: End If
    
If Sheets("Config").Range("F19").Value > 0 Then

If Sheets("Config").Range("F19").Value > 0 And Sheets("Config").Range("C8").Value = 5 Then
    .Attachments.Add Sheets("Config").Range("F66").Value, olByValue, 0
    
Else: End If
    .Attachments.Add Sheets("Config").Range("F19").Value, olByValue, 0

Else: End If

Else: End If

If Sheets("Config").Range("A14").Value = 1 Then

If Sheets("Config").Range("D21").Value > 0 Then
    .Attachments.Add Sheets("Config").Range("D21").Value, olByValue, 0
Else: End If
    
If Sheets("Config").Range("D20").Value > 0 Then
    .Attachments.Add Sheets("Config").Range("D20").Value, olByValue, 0
Else: End If
    
If Sheets("Config").Range("D19").Value > 0 Then
    .Attachments.Add Sheets("Config").Range("D19").Value, olByValue, 0
Else: End If

Else: End If
    
Else: End If

If Sheets("Config").Range("A14").Value = 3 Then

If Sheets("Config").Range("H21").Value > 0 Then
    .Attachments.Add Sheets("Config").Range("H21").Value, olByValue, 0
Else: End If
    
If Sheets("Config").Range("H20").Value > 0 Then
    .Attachments.Add Sheets("Config").Range("H20").Value, olByValue, 0
Else: End If
    
If Sheets("Config").Range("H19").Value > 0 Then
    .Attachments.Add Sheets("Config").Range("H19").Value, olByValue, 0


Else: End If

'--------
If Sheets("Config").Range("C8").Value = 3 Then

If Sheets("Config").Range("D21").Value > 0 Then
    .Attachments.Add Sheets("Config").Range("D21").Value, olByValue, 0
Else: End If
    
If Sheets("Config").Range("D20").Value > 0 Then
    .Attachments.Add Sheets("Config").Range("D20").Value, olByValue, 0
Else: End If
    
If Sheets("Config").Range("D19").Value > 0 Then
    .Attachments.Add Sheets("Config").Range("D19").Value, olByValue, 0
Else: End If
    
End If

Else: End If

 If Sheets("Config").Range("A14").Value = 2 Then
 If Sheets("Config").Range("A14").Value = 2 And Sheets("Config").Range("C8").Value = 5 Then
 
    .HTMLBody = .HTMLBody _
                & "<br>Catálogo on-line: www.youblisher.com/p/1255463-Leader/" & "<br>" _
                & "<br><B>LEADER NUTRITION - www.LEADERNUTRITION.com.br</B><br>" _
                & "<br>Facebook: leader_nutrition   / Instagram" & "<br><br>" _
                & Sheets("Config").Range("F50").Value & Sheets("Config").Range("F53").Value & "><br>" _
                & "<br>" _
                & Sheets("Config").Range("F56").Value & Sheets("Config").Range("F59").Value & "><br>" _

    .Attachments.Add Sheets("Config").Range("F23").Value, olByValue, 0

 GoTo Apresentacao
 
Else
 
    .HTMLBody = .HTMLBody _
                & "<br>" _
                & "<br>Catálogo on-line: www.youblisher.com/p/1255463-Leader/" & "<br>" _
                & "<br><B>LEADER NUTRITION - www.LEADERNUTRITION.com.br</B><br>" _
                & "<br>Facebook: leader_nutrition   / Instagram" & "<br><br>" _
                & Sheets("Config").Range("F50").Value & Sheets("Config").Range("F53").Value & "><br>" _
                & "<br>" _
                & Sheets("Config").Range("F56").Value & Sheets("Config").Range("F59").Value & "><br>" _

    .Attachments.Add Sheets("Config").Range("F23").Value, olByValue, 0
    
End If

Else: End If

 If Sheets("Config").Range("A14").Value = 1 Then
    .HTMLBody = .HTMLBody _
                & "<br><B>GAUER DO BRASIL - www.GAUERDOBRASIL.com.br</B>" _
                & "<br><B>G-ACTION - www.G-ACTIONSUPLEMENTOS.com.br</B><br><br>" _
                & Sheets("Config").Range("D50").Value & Sheets("Config").Range("D53").Value & "><br>" _
                & "<br>" _
                & Sheets("Config").Range("D56").Value & Sheets("Config").Range("D59").Value & "><br>" _

    .Attachments.Add Sheets("Config").Range("D23").Value, olByValue, 0
    
Else: End If

 If Sheets("Config").Range("A14").Value = 2 And Sheets("Config").Range("A14").Value <> 2 Then
 
    .HTMLBody = .HTMLBody _
                & "<br><B>GAUER DO BRASIL - www.GAUERDOBRASIL.com.br</B>" _
                & "<br><B>LEADER NUTRITION - www.G-LEADERNUTRITION.com.br</B><br><br>" _
                & Sheets("Config").Range("H50").Value & Sheets("Config").Range("H53").Value & "><br>" _
                & "<br>" _
                & Sheets("Config").Range("H56").Value & Sheets("Config").Range("H59").Value & "><br>" _

    .Attachments.Add Sheets("Config").Range("F23").Value, olByValue, 0
Else: End If

GoTo Apresentacao
Apresentacao:

    '    .Display
    
If Sheets("Config").Range("A19").Value = 10 Then
       .ReadReceiptRequested = True ' confirmação de leitura
       .SendUsingAccount = olapp.Session.Accounts.Item(idEmail)
       .Display
       
GoTo Email

Else
       .ReadReceiptRequested = Leitura ' confirmação de leitura
       .SendUsingAccount = olapp.Session.Accounts.Item(idEmail)
If Sheets("Config").Range("C6").Value = 1 Then
       .Display
 Else
       .Send
End If
End If
GoTo Segue2
       
'Else
'End If
'------------------------------------------------

         'Para pré visualizar a mensagem usar Display. Para enviar direto sem visualizar, use Send
                  
  If Range("A23").Value = "DISPLAY" Then
                  
  '     .Display
         
       .ReadReceiptRequested = Leitura ' confirmação de leitura
       .SendUsingAccount = olapp.Session.Accounts.Item(idEmail)
       .Display

GoTo Segue2

Else

 '      .Display
         
       .ReadReceiptRequested = Leitura ' confirmação de leitura
       .SendUsingAccount = olapp.Session.Accounts.Item(idEmail)
       .Send

GoTo Segue2
Segue2:

End If
  
   Set olapp = Nothing
     Set OlMensagem = Nothing
     Mensagem = ""
     
     
End With

 
Next

GoTo Fim
Fim:

    Range("C3:C505").Select
    Selection.ClearContents
    Range("Q1").Select
    Selection.ClearContents
    Range("Q2").Select
    Selection.ClearContents
    Range("A20").Select
    Selection.ClearContents
    Range("A23").Select
    Selection.ClearContents
    Range("B12").Select
    Selection.ClearContents
    
 Sheets("Config").Select
 
If Range("A19").Value = 9 Then
If Range("B35").Value = 1 Then
Range("B35").Value = 2
GoTo C
Else
End If

If Range("B35").Value = 2 Then
Range("B35").Value = 3
GoTo C
Else
End If

 If Range("B35").Value = 3 Then
    Range("B35").Value = 1
    
 Else
 End If
 
 Else
 End If
 
GoTo C
C:

Sheets(Loja).Select
    
If Range("A1").Value = "MUNDO VERDE" Or Range("A1").Value = "VIA VERDE" Or Range("A1").Value = "BRASIL" Then

GoTo Vamos
Else
End If

Sheets("Config").Select
GoTo Terminar

GoTo Vamos
Vamos:

  t = ActiveSheet.Range("G11")
  A = t + 1
  Application.ActiveSheet.Range("G11").Value = A
  
    Range("J10").Select
    Selection.Copy
    Sheets("CONFIG").Select
    Range("J2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


   Sheets("Envios Individuais").Visible = False


Sheets(Loja).Select

If Range("A1").Value = "MUNDO VERDE" And Range("G11").Value = 26 Then
Range("G11").Value = 1

Sheets("CONFIG").Select
    Range("J2").Select
    Selection.ClearContents


Else
End If

If Range("A1").Value = "VIA VERDE" And Range("G11").Value = 10 Then
Range("G11").Value = 1

Sheets("CONFIG").Select
    Range("J2").Select
    Selection.ClearContents

Else
End If

If Range("A1").Value = "BRASIL" And Range("G11").Value = 9 Then
Range("G11").Value = 1

Sheets("CONFIG").Select
    Range("J2").Select
    Selection.ClearContents


Else
End If


'   Sheets(Revenda).Visible = False
  Sheets("Config").Select
   
 If Range("C9").Value = 1 Then
 If Sheets(Loja).Range("G11").Value = 1 Then
GoTo By
Else
GoTo Volte

End If
End If

GoTo By
By:

  Sheets(Revenda).Visible = False
    Sheets("MAPA").Visible = True
  
GoTo Terminar
Terminar:
  
If Range("A19").Value = 1 Or Range("A19").Value = 2 Or Range("A19").Value = 5 Or Range("A19").Value = 9 Then
GoTo bb
Else
End If

GoTo bb
bb:

If Range("A1").Value = "TESTE DE ENVIO" Then
  Sheets(Revenda).Visible = False
    Sheets("Envios Individuais").Visible = False
Else
End If
  Sheets(Revenda).Visible = False

If Sheets("Config").Range("C12").Value = 0 Then

resultado = MsgBox("DESEJA APAGAR OS PARÂMETROS DO CONFIG ( SIM ) ou ( NÃO ) ?", vbYesNo, "Tomando uma Decisão")
        
If resultado = vbYes Then

Range("A6").Value = 6
Range("A19").Value = 11
Range("C9").Value = 2
Range("C5").Value = 1
Range("C6").Value = 1
Range("C7").Value = 2
Range("C8").Value = 6
Range("C10").Value = 4
Range("A3").Value = 1
Range("B35").Value = ""

Else: End If

Else: End If


GoTo Email
Email:

    Sheets("Config").Range("B32").Select
    Selection.ClearContents
    Sheets("Config").Range("B40").Select
    Selection.ClearContents

End Sub
 
Postado : 30/06/2016 3:05 pm
 fazerbem
(@fazerbem)
Posts: 0
New Member
Topic starter
 

Nao adaptei ainda na macro acima, esta no metodo antogo as MsgBox

 
Postado : 30/06/2016 4:04 pm
 Basole
(@basole)
Posts: 487
Reputable Member
 

Segue codigo para usar em um userform: 

Private Sub CommandButton1_Click()
' ** Botao abre o userform ****
Dim m_Email As String, m_Assu As String, msg As String

msg = "Preencha todos dados!"
m_Email = TextBox1.Text
m_Assu = TextBox2.Text

If m_Email = "" Then MsgBox msg, 64, "Atencao": TextBox1.SetFocus: Exit Sub
If m_Assu = "" Then MsgBox msg, 64, "Atencao": TextBox2.SetFocus: Exit Sub

With Sheets("plan1") ' altere o nome da sua aba, se necessario
.Range("B32").Value = m_Email
.Range("B44").Value = m_Assu
End With

End Sub

Private Sub CommandButton2_Click()
' ** Botao sair ***
Unload Me
End Sub

Dica: * se quiser acrescentar esta função que valida o email (caso o usuario digite incorretamente) :
http://www.planilhando.com.br/forum/viewtopic.php?f=10&t=17252&p=87420

 
Postado : 30/06/2016 4:27 pm
 fazerbem
(@fazerbem)
Posts: 0
New Member
Topic starter
 

Grato amigo, deu tudo certo e optei pela userform.

Andre

 
Postado : 01/07/2016 9:14 am
Forum Jump:
  Tópico Anterior
Próximo Tópico