none
Enviar excel por email mas sem alterar os valores monetários, como valor e percentuais. RRS feed

  • Pergunta

  • Enviar excel por email mas sem alterar os valores monetários, como valor e percentuais

    Exemplo:

    Prezado(a) Sr(a) JOSÉ DE ALMEIDA, segue o Comparativo do mês de Outubro-2013-2014 para sua apreciação. <o:p></o:p>

    Venda-2013  R$ 70359,03     (R$ 70.359,03)<o:p></o:p>

    Venda-2014  R$ 77974,99     (R$ 77.974,99)<o:p></o:p>

       Dif(%)Ago: 0,09                                (9,02%)
       Dif(%)Jul: 9,76718304163939E-02   (9,76%)
       Dif(%)Jun: 107767,98                        (108%)
       Dif(%)Mai: 123220,3                         (124%)
       Dif(%)Abr: 0,143385075975257       (14%)
       Dif(%)Mar:
       Dif(%)Fev:
       Dif(%)Jan: <o:p></o:p>

    Atenciosamente,
    Departamento de Informática
    Contato: (11) 9999-9999 - Ramal 9999 

    <o:p></o:p>

    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 = ActiveCell.Row - 1
        If Target.Address = "$O$" & linha Then

            If Plan1.Cells(linha, 15) = "S" Then
                texto = "Prezado(a) Sr(a) " & Plan1.Cells(linha, 3) & ", segue o Comparativo do mês de Outubro-2013-2014 para sua apreciação." & vbCrLf & vbCrLf & _
                        "Venda-2013  R$ " & Plan1.Cells(linha, 4) & "" & vbCrLf & vbCrLf & _
                        "Venda-2014  R$ " & Plan1.Cells(linha, 5) & "" & vbCrLf & vbCrLf & _
                        "   Dif(%)Dez: " & Cells.Text(linha, 6) & "" & vbCrLf & _
                        "   Dif(%)Nov: " & Cells.Text(linha, 7) & "" & vbCrLf & _
                        "   Dif(%)Out: " & Cells.Text(linha, 8) & "" & vbCrLf & _
                        "   Dif(%)Set: " & Plan1.Cells(linha, 9) & "" & vbCrLf & _
                        "   Dif(%)Ago: " & Plan1.Cells(linha, 10) & "" & vbCrLf & _
                        "   Dif(%)Jul: " & Plan1.Cells(linha, 11) & "" & vbCrLf & _
                        "   Dif(%)Jun: " & Plan1.Cells(linha, 12) & "" & vbCrLf & _
                        "   Dif(%)Mai: " & Plan1.Cells(linha, 13) & "" & vbCrLf & _
                        "   Dif(%)Abr: " & Plan1.Cells(linha, 14) & "" & vbCrLf & _
                        "   Dif(%)Mar: " & Plan1.Cells(linha, 15) & "" & vbCrLf & _
                        "   Dif(%)Fev: " & Plan1.Cells(linha, 16) & "" & vbCrLf & _
                        "   Dif(%)Jan: " & Plan1.Cells(linha, 17) & "" & vbCrLf & vbCrLf & _
                        "Atenciosamente," & vbCrLf & _
                        "Departamento de Informática" & vbCrLf & _
                        "Contato: (11) 9999-9999 - Ramal 9999 "
            End If

            With OutMail
                .To = Plan1.Cells(linha, 1)
                .CC = ""
                .BCC = ""
                .Subject = "Comparativo de Outubro - 2013/2014"
                .Body = texto
                .Display   'Utilize Send para enviar o email sem abrir o Outlook
            End With
            On Error GoTo 0

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

    • Editado Eduardo Alves Manoel quarta-feira, 19 de novembro de 2014 17:13 Estou utilizando uma macro para isso
    quinta-feira, 13 de novembro de 2014 13:52

Todas as Respostas

  • Olá Eduardo!

    Não está muito claro o problema que você está tendo... De qualquer forma, vou te recomendar um suplemento desenvolvido por um colega aqui do Fórum que possui muitas funcionalidades, dentre elas várias opções para envio de planilhas por email. Acesse o link:

    http://www.ambienteoffice.com.br/excel/expressxl/#mailxl


    Rafael Kamimura

    quinta-feira, 13 de novembro de 2014 13:55
  • Boa tarde...

    Acredito que um format ja ajuda. 

    no objeto de email (pelas tags acredito que voce esta usando o HTMLbody), insira os valores com o format (não sei se voce esta dando replace no corpo do email, mas funciona da mesma forma).

    Exemplo:

    Function formataValor(ByVal valor As Variant, opc As String) As String
        'opc será o tipo Ex Percentual, valor, decimal
        Select Case opc
        Case "Percentual"
            formataValor = Format((valor * 100), "###,###,##0.00") & "%"
            Exit Function
        Case "Decimal"
            formataValor = Format(valor, "###,###,##0.00")
            Exit Function
        Case "Inteiro"
            formataValor = Format(valor, "###,###,##0")
            Exit Function
        End Select
        
        
    End Function

    Espero ter ajudado...

    Att.

    Erik

    quinta-feira, 13 de novembro de 2014 17:22
  • Eduardo,

    Você escreveu algum código? Se sim, poste aqui.

    Antecipadamente, já digo para você trocar as instruções Cells.Value por Cells.Text, pois assim os valores das células são gravados de acordo com o que é exibido na célula, e não seu valor intrínseco.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 13 de novembro de 2014 21:34
    Moderador