Notifications
Clear all

Ajustar casas decimais pelo VBA - Range.Value

5 Posts
2 Usuários
0 Reactions
1,336 Visualizações
(@necron)
Posts: 117
Estimable Member
Topic starter
 

Boa Tarde a Todos! :)

Eu estou montando uma planilha que envia e-mails diretos sem utilizar o outlook, e nesse e-mail enviado utilizo a informação do excel.

Segue abaixo imagem do Excel:

Segue o e-mail recebido pelo destinatário:

Eu gostaria de deixar apenas 1 casa decimal após a virgula e isso tem que ser feito no VBA, pois já tentei no Excel de varias formas sem sucesso.

Segue abaixo o código que utilizo:

Sub Enviar_Mail()
Dim HTML
Dim lobj_cdomsg As CDO.Message
Set lobj_cdomsg = New CDO.Message


With lobj_cdomsg.Configuration
.Fields(cdoSendUserName) = "blablabla@minhaempresa.com.br" 'Endereço de e-mail para autenticar no servidor
.Fields(cdoSendPassword) = "minhasenha" 'Senha do e-mail para autenticar no servidor
.Fields(cdoSMTPAuthenticate) = cdoBasic
.Fields(cdoSMTPServer) = "mail.minhaempresa.com.br" 'Nome do servidor SMTP
.Fields(cdoSMTPConnectionTimeout) = 25 'Porta
.Fields(cdoSMTPServerPort) = 25 'Porta
.Fields(cdoSendUsingMethod) = cdoSendUsingPort
.Fields.Update
End With


'####
'MENSAGEM DE SAUDAÇÕES
'####

HTML = HTML & "<head>"
HTML = HTML & "<body>"
HTML = HTML & "<font size='4' font color= #0000FF face='Calibri'><b>Ola "
HTML = HTML & Sheets("DASHBOARD").Range("C2").Value
HTML = HTML & "!</b></font>"
HTML = HTML & "<br>"
HTML = HTML & "<br>"

'####
'MENSAGEM DO CORPO DO E-MAIL
'####

HTML = HTML & "<font size='3' font color= #0000FF face='Calibri'>"
HTML = HTML & Sheets("DASHBOARD").Range("C8").Value
HTML = HTML & "</font>"
HTML = HTML & "<br>"
HTML = HTML & "<br>"
HTML = HTML & "<br>"

'####
'TITULO DO RELATORIO DE PROJEÇÕES DE ATINGIMENTOS
'####

HTML = HTML & "<hr>"
HTML = HTML & "<font size='4' font color= ##FF0000 face='Calibri'><b>"
HTML = HTML & Sheets("DASHBOARD").Range("D13").Value
HTML = HTML & "</b></font>"
HTML = HTML & "<br>"
HTML = HTML & "<br>"

'####
'TABELA COM AS PROJEÇÕES DE ATINGIMENTOS
'POR GRUPO DE PRODUTOS EM FORMATO HTML.
'####

HTML = HTML & "<TABLE BORDER=1 CELLSPACING=0 CELLPADDING=2>" 'Inicia a tabela e coloca uma borda
HTML = HTML & "<TR>" 'Abre a primeira linha da tabela
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>" '1ª coluna da linha 1
    HTML = HTML & Sheets("DASHBOARD").Range("C16").Value
    HTML = HTML & "</TD>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>" '2ª coluna da linha 1
    HTML = HTML & Sheets("DASHBOARD").Range("D16").Value
    HTML = HTML & "</TD>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>" '3ª coluna da linha 1
    HTML = HTML & Sheets("DASHBOARD").Range("F16").Value
    HTML = HTML & "</TD>"
HTML = HTML & "</TR>" 'Fecha a primeira linha da tabela

HTML = HTML & "<TR>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>"
    HTML = HTML & Sheets("DASHBOARD").Range("C17").Value
    HTML = HTML & "</TD>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>"
    HTML = HTML & Sheets("DASHBOARD").Range("D17").Value
    HTML = HTML & "</TD>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>"
    HTML = HTML & Sheets("DASHBOARD").Range("F17").Value
    HTML = HTML & "</TD>"
HTML = HTML & "</TR>"

HTML = HTML & "<TR>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>"
    HTML = HTML & Sheets("DASHBOARD").Range("C18").Value
    HTML = HTML & "</TD>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>"
    HTML = HTML & Sheets("DASHBOARD").Range("D18").Value
    HTML = HTML & "</TD>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>"
    HTML = HTML & Sheets("DASHBOARD").Range("F18").Value
    HTML = HTML & "</TD>"
HTML = HTML & "</TR>"

HTML = HTML & "<TR>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>"
    HTML = HTML & Sheets("DASHBOARD").Range("C19").Value
    HTML = HTML & "</TD>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>"
    HTML = HTML & Sheets("DASHBOARD").Range("D19").Value
    HTML = HTML & "</TD>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>"
    HTML = HTML & Sheets("DASHBOARD").Range("F19").Value
    HTML = HTML & "</TD>"
HTML = HTML & "</TR>"
HTML = HTML & "</TABLE>" 'Fim da tabela
HTML = HTML & "<br>"
HTML = HTML & "<br>"

'####
'RELATORIO DE TROCAS POR MÊS
'####

HTML = HTML & "<hr>"
HTML = HTML & "<font size='4' font color= ##FF0000 face='Calibri'><b>"
HTML = HTML & Sheets("DASHBOARD").Range("D23").Value
HTML = HTML & "</b></font>"
HTML = HTML & "<br>"
HTML = HTML & "<br>"
HTML = HTML & "<img border='0' src='1.gif' "
HTML = HTML & "<br>"
HTML = HTML & "<br>"
HTML = HTML & "<br>"

'####
'RELATORIO DE TROCAS POR CATEGORIA - PRINCIPAIS
'####

HTML = HTML & "<hr>"
HTML = HTML & "<font size='4' font color= ##FF0000 face='Calibri'><b>"
HTML = HTML & Sheets("DASHBOARD").Range("D41").Value
HTML = HTML & "</b></font>"
HTML = HTML & "<br>"
HTML = HTML & "<br>"
HTML = HTML & "<img border='0' src='2.gif' "
HTML = HTML & "<br>"
HTML = HTML & "<br>"
HTML = HTML & "<br>"

HTML = HTML & "<br>"
HTML = HTML & "</body>"
HTML = HTML & "</html>"


With lobj_cdomsg
.To = Sheets("DASHBOARD").Range("C3").Value 'Endereço destinatario (PARA:)
.CC = Sheets("DASHBOARD").Range("C4").Value 'Endereço destinatario (COM COPIA:)
.BCC = ""
.From = Sheets("DASHBOARD").Range("C5").Value 'Endereço do remetente
.Subject = "Teste enviar e-mail com grafico"
.AddAttachment "C:graficos1.gif", olByReference, 1
.AddAttachment "C:graficos2.gif", olByReference, 1
.HTMLBody = HTML 'Mensagem que foi montada
.Send
End With

Set lobj_cdomsg = Nothing

MsgBox "E-mail enviado com sucesso", vbInformation, "E-Mail enviado!" 'Mensagem de E-mail enviado com sucesso

End Sub

A parte do código que gera o corpo do e-mail é essa:

HTML = HTML & "<TABLE BORDER=1 CELLSPACING=0 CELLPADDING=2>" 'Inicia a tabela e coloca uma borda
HTML = HTML & "<TR>" 'Abre a primeira linha da tabela
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>" '1ª coluna da linha 1
    HTML = HTML & Sheets("DASHBOARD").Range("C16").Value
    HTML = HTML & "</TD>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>" '2ª coluna da linha 1
    HTML = HTML & Sheets("DASHBOARD").Range("D16").Value
    HTML = HTML & "</TD>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>" '3ª coluna da linha 1
    HTML = HTML & Sheets("DASHBOARD").Range("F16").Value
    HTML = HTML & "</TD>"
HTML = HTML & "</TR>" 'Fecha a primeira linha da tabela

Se algum mestre do Excel puder me ajudar, vai ser muito ultil para minha carreira ;)

Abraços.

 
Postado : 28/03/2013 11:33 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Se voce "restringir" esses valores no proio excel, não funciona.
Utilize Truncar ou Arred.
Ou no codigo, identifique qual as linhas que "pegam" o valor e utilize Vba.round (veja abaixo)
Creio que são:

HTML = HTML & "<TR>"
        HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
        HTML = HTML & "<TD>"
        HTML = HTML & Sheets("DASHBOARD").Range("C17").Value
        HTML = HTML & "</TD>"
        HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
        HTML = HTML & "<TD>"
        HTML = HTML & VBA.Round(Sheets("DASHBOARD").Range("D17").Value, 2)
        HTML = HTML & "</TD>"
        HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
        HTML = HTML & "<TD>"
        HTML = HTML & VBA.Round(Sheets("DASHBOARD").Range("F17").Value, 2)
        HTML = HTML & "</TD>"
    HTML = HTML & "</TR>"

    HTML = HTML & "<TR>"
        HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
        HTML = HTML & "<TD>"
        HTML = HTML & Sheets("DASHBOARD").Range("C18").Value
        HTML = HTML & "</TD>"
        HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
        HTML = HTML & "<TD>"
        HTML = HTML & VBA.Round(Sheets("DASHBOARD").Range("D18").Value, 2)
        HTML = HTML & "</TD>"
        HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
        HTML = HTML & "<TD>"
        HTML = HTML & VBA.Round(Sheets("DASHBOARD").Range("F18").Value, 2)
        HTML = HTML & "</TD>"
    HTML = HTML & "</TR>"

    HTML = HTML & "<TR>"
        HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
        HTML = HTML & "<TD>"
        HTML = HTML & Sheets("DASHBOARD").Range("C19").Value
        HTML = HTML & "</TD>"
        HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
        HTML = HTML & "<TD>"
        HTML = HTML & VBA.Round(Sheets("DASHBOARD").Range("D19").Value, 2)
        HTML = HTML & "</TD>"
        HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
        HTML = HTML & "<TD>"
        HTML = HTML & VBA.Round(Sheets("DASHBOARD").Range("F19").Value, 2)
        HTML = HTML & "</TD>"
    HTML = HTML & "</TR>"
    HTML = HTML & "</TABLE>" 'Fim da tabela
    HTML = HTML & "<br>"
    HTML = HTML & "<br>"
 
Postado : 28/03/2013 12:06 pm
(@necron)
Posts: 117
Estimable Member
Topic starter
 

Funcionou quase 100%!!!

Como vocês consegue decorar esses códigos todos hein? Muito obrigado.

Só não ficou 100% devido a uma célula conforme imagem abaixo:


Acredito que essa célula não tenha ficado com 2 casas após a virgula devido ela ser um numero "redondo" após a virgula.

Trecho do código referente a essa célula (F18):

HTML = HTML & "<TR>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>"
    HTML = HTML & Sheets("DASHBOARD").Range("C18").Value
    HTML = HTML & "</TD>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>"
    HTML = HTML & VBA.Round(Sheets("DASHBOARD").Range("D18").Value, 2)
    HTML = HTML & "</TD>"
    HTML = HTML & "<font size='3' font color= ##000000 face='Calibri'>"
    HTML = HTML & "<TD>"
    HTML = HTML & VBA.Round(Sheets("DASHBOARD").Range("F18").Value, 2)
    HTML = HTML & "</TD>"
HTML = HTML & "</TR>"

Se complicar muito não vou mexer mais, vou deixar dessa forma, pois melhorou 95% do que estava antes.

 
Postado : 28/03/2013 12:39 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Experimente utilizar em conjunto com o Format

Format(VBA.Round(Sheets("DASHBOARD").Range("F18").Value, 2),"#,##0.00")

 
Postado : 28/03/2013 1:08 pm
(@necron)
Posts: 117
Estimable Member
Topic starter
 

Perfeito Reinaldo!

Isso vai me render uma promoção! rsrs :D

Quando eu terminar esse projeto no Excel, vou enviar diariamente e-mails para 200 vendedores em todo estado de SP com a performance individual de cada um, e com cerca de 10 gráficos de diferentes indicadores de performance de vendas, ou seja, um dashboard de vendas atualizado diariamente e enviado por e-mail.

Muito obrigado pela ajuda.
Abraços

 
Postado : 28/03/2013 1:24 pm