Notifications
Clear all

Alterar coluna apos clique de envio

3 Posts
2 Usuários
0 Reactions
587 Visualizações
(@grod07)
Posts: 1
New Member
Topic starter
 

Boa noite galera preciso de ajuda!!!

pequei uma rotina vba da net só que preciso de alguns ajustes, na planilha em anexo tem uma coluna "Situação" a qual quero que seja alterada para "Enviado" quando clicado em sim.

desde já agradeço

 
Postado : 14/06/2013 4:26 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Troque pela rotina abaixo e faça os testes se é isto.

Sub Auto_open()
'código extraído de http://social.msdn.microsoft.com/Forums/pt-BR/excelpt/thread/32fe8b47-185e-47ce-b32f-c0e0e7f19d5b
'editado por Gleison em 11/06/13

    Dim x As Integer, resultado As VbMsgBoxResult
    Range("A12").Select
    Selection.End(xlDown).Select
    x = ActiveCell.Row

    For M = 12 To x
        If Range("L" & M) = "Enviar" Then
             resultado = MsgBox("Deseja enviar email para o Fornecedor " & Range("N" & M).Value & "?" & vbCrLf _
             & "*NF " & Range("E" & M).Value & ". Dias em aberto " & Range("K" & M).Value, vbYesNo)
             
             If resultado = 6 Then
                 
                Set myOlApp = CreateObject("Outlook.Application")
                Set myItem = myOlApp.CreateItem(olMailItem)
                Set myAttachments = myItem.Attachments
                
                    Range("L" & M).Value = "Enviado"
                
                    With myItem
                        .To = Range("M" & M).Value 'DESTINATÁRIO
                        .Subject = "Mensagem Automática! CONTROLE DE MERCADORIAS GUARARAPES" 'ASSUNTO
                        .Body = vbCrLf & vbCrLf _
                         & "Caro Cliente/Fornecedor: " & Range("N" & M).Value & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                         & "Esta mensagem é automática, Por gentileza, solicitamos sua atenção para situação abaixo:" & vbCrLf & vbCrLf _
                         & "Em atendimento ao Art. 334 do RICMS/PR 6080/12, detectamos que se encontra pendente o documento  abaixo relacionado: " & vbCrLf & vbCrLf _
                         & "*NF " & Range("E" & M).Value & "  Emissão em: " & Range("i" & M).Value & "  Item: " & Range("c" & M).Value & ",  emitido a " & Range("K" & M).Value & "  dias." & vbCrLf & vbCrLf _
                         & "Solicitamos a devolução fiscal para a devida regularização" & vbCrLf & vbCrLf _
                         & "Certos de contar com sua compreenssão aguardamos retorno" & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                         & "Em caso de dúvidas nos contatar artavés do Tel: (46) 3263-8347 ou através do email gleison@guararapes.com.br" & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                         & "Sds," & vbCrLf _
                         & "Dpto Fiscal" & vbCrLf _
                         & "www.guararapes.com.br" & vbCrLf _
                         & "Política de Privacidade. Esta mensagem (incluindo qualquer anexo) é CONFIDENCIAL e legitimamente protegida, somente podendo ser usada pelo indivíduo ou entidade a quem foi endereçada. Caso você a tenha recebido por engano, deverá devolve-la ao remetente e apagá-la. A disseminação, encaminhamento, uso, impressão ou cópia do conteúdo desta mensagem são expressamente proibidos." 'CORPO DO EMAIL
                        .Save
                        .Send
                    End With
                 
                Else
                 
                 'Nao enviou
        
            End If
            
        End If
        
    Next M

End Sub

Qualquer duvida retorne.

[]s

 
Postado : 14/06/2013 6:08 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Tente assim...

Sub Auto_open()
'código extraído de http://social.msdn.microsoft.com/Forums/pt-BR/excelpt/thread/32fe8b47-185e-47ce-b32f-c0e0e7f19d5b
'editado por Gleison em 11/06/13

    'Stop
    Dim x As Integer, resultado As VbMsgBoxResult
    Range("A12").Select
    Selection.End(xlDown).Select
    x = ActiveCell.Row
    For M = 12 To x
        If Range("L" & M) = "Enviar" Then
            resultado = MsgBox("Deseja enviar email para o Fornecedor " & Range("N" & M).Value & "?" & vbCrLf _
            & "*NF " & Range("E" & M).Value & ". Dias em aberto " & Range("K" & M).Value, vbYesNo)
            If resultado = 6 Then
                 
                Set myOlApp = CreateObject("Outlook.Application")
                Set myItem = myOlApp.CreateItem(olMailItem)
                Set myAttachments = myItem.Attachments
                 
                With myItem
                    .To = Range("M" & M).Value 'DESTINATÁRIO
                    .Subject = "Mensagem Automática! CONTROLE DE MERCADORIAS GUARARAPES" 'ASSUNTO
                    .Body = vbCrLf & vbCrLf _
                    & "Caro Cliente/Fornecedor: " & Range("N" & M).Value & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                    & "Esta mensagem é automática, Por gentileza, solicitamos sua atenção para situação abaixo:" & vbCrLf & vbCrLf _
                    & "Em atendimento ao Art. 334 do RICMS/PR 6080/12, detectamos que se encontra pendente o documento  abaixo relacionado: " & vbCrLf & vbCrLf _
                    & "*NF " & Range("E" & M).Value & "  Emissão em: " & Range("i" & M).Value & "  Item: " & Range("c" & M).Value & ",  emitido a " & Range("K" & M).Value & "  dias." & vbCrLf & vbCrLf _
                    & "Solicitamos a devolução fiscal para a devida regularização" & vbCrLf & vbCrLf _
                    & "Certos de contar com sua compreenssão aguardamos retorno" & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                    & "Em caso de dúvidas nos contatar artavés do Tel: (46) 3263-8347 ou através do email gleison@guararapes.com.br" & vbCrLf & vbCrLf & vbCrLf & vbCrLf _
                    & "Sds," & vbCrLf _
                    & "Dpto Fiscal" & vbCrLf _
                    & "www.guararapes.com.br" & vbCrLf _
                    & "Política de Privacidade. Esta mensagem (incluindo qualquer anexo) é CONFIDENCIAL e legitimamente protegida, somente podendo ser usada pelo indivíduo ou entidade a quem foi endereçada. Caso você a tenha recebido por engano, deverá devolve-la ao remetente e apagá-la. A disseminação, encaminhamento, uso, impressão ou cópia do conteúdo desta mensagem são expressamente proibidos." 'CORPO DO EMAIL
                     '.Save
                     '.Send
                    .display
                End With
                Range("L" & M).Value = "Foi Enviado"
            End If
        End If
    Next M
End Sub
 
Postado : 15/06/2013 10:37 am