Excel Enviar um intervalo no corpo do e-mail (VBA)

[LucasExcel]

Bom dia

 

Gostaria de enviar o corpo do e-mail o intervalo da célula G4 até I23 (copiar o intervalo e colar no e-mail) contido na aba "Tabela dinamica - Volume" e o Grafico 6 como imagem (o gráfico está na aba "Tabela dinamica - Volume")

Obs: Para o grafico 6 o comprimento é de 12,55 cm e a largura é de 40 cm

 

 

No momento eu tenho o código abaixo onde ele envia via e-mail com os destinatários ja informados e com o texto ja informado.

 

 

 

 

Sub MacroEmail()
'
' Macro17 Macro
                     
Set objeto_outlook = CreateObject("Outlook.Application")
Set Email = objeto_outlook.CreateItem(0)

Email.Display
Email.CC = "xxxx"
Email.To = "xxxxx"
    
Email.Subject = "xxxxx"

Email.Body = "Prezados," & Chr(10) & Chr(10) & "Segue em anexo " & Chr(10) _
& Chr(10) & "" & ActiveWorkbook.Sheets("Dash").Range("b2").Value & "" & ":" & "" & ActiveWorkbook.Sheets("Dados").Range("s3").Value & "" _
& "" & ActiveWorkbook.Sheets("Dados").Range("Q7").Value & Chr(10) & Chr(10) & ""

    
     'troque o diretorio do documento que queira enviar 'add' anexo.
    Email.Attachments.Add "\\xxxxxxxxxxxxxxxxxxxxxxxx"

       Email.Display

[LucasExcel]

Relatório de expedição rodoviário.zipEstou enviando o arquivo comprimido em anexo, para ajudar na visualização.  

 

e uma imagem como ficará o e-mail.Não sei se é possível que o gráfico fique do lado, se for possível eu diminui um pouco o tamanho do mesmo, se não for possível ok.

 

Obrigado pela ajuda

 

Relatório de expedição rodoviário.zip

[Muca Costa]

Veja se o anexo lhe ajuda...

Relatório de expedição rodoviário.rar

[LucasExcel]

@Muca Costa  Obrigado pela ajuda, porém não consigo utilizar o código, mostra o erro abaixo.

 

[LucasExcel]

Então eu alterei o código inicial ( que enviei no primeiro post) e inseri o complemento abaixo que ficou posicionado antes de criar o e-mail. Ele copia o intervalo porém não consigo um código que cole e com a largura 46 e altura 12,67

 

Sheets("Tabela dinamica - Volume").Select
   ActiveSheet.Range("f3:AL31").Select
   Application.CutCopyMode = False
   Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

[Muca Costa]

Sub MacroEmail()
    Dim sh As Worksheet
    grafico_para_imagem
    On Error Resume Next
    Set sh = Sheets("Tabela dinamica - Volume")
    Set objeto_outlook = CreateObject("Outlook.Application")
    Set Email = objeto_outlook.CreateItem(0)

    Email.Display
    Email.CC = "" 'Informe
    Email.To = "" 'Informe
    
    Email.Subject = "Relatório de expedição rodoviário"
    ActiveSheet.Range("F3:I31").Select
    Selection.Copy
    Email.Attachments.Add ThisWorkbook.Path & "\Carregamento.gif", olByReference, 1
    Email.HTMLBody = sh.Range("F3:I31") & "<img border='0' src='temp.gif'  width='1267' height='460'>"
    Email.Display
    Application.SendKeys "{TAB 4}"
    Application.SendKeys "^v"
End Sub

Sub grafico_para_imagem()
    Set Gráfico = Sheets("Tabela dinamica - Volume").ChartObjects(1).Chart
    ArquivoGIF = ThisWorkbook.Path & "\Carregamento.gif"
    Gráfico.Export Filename:=ArquivoGIF, FilterName:="GIF"
End Sub

 

[Muca Costa]

Corrigindo:

DE:

Email.HTMLBody = sh.Range("F3:I31") & "<img border='0' src='temp.gif' width='1267' height='460'>"

PARA:

Email.HTMLBody = "<img border='0' src='Carregamento.gif'  width='1267' height='460'>"
            

[LucasExcel]

@Muca Costa  ja me ajuda bastante. Agora eu só faço a quebra de texto na imagem e ponho do lado da tabela, porém eu perdi os dizeres ( "Prezados" -> pula duas linhas -> xxxxxxxx). E quando tentei colocar no campo Email.HTMLBody deu erro na hora de inserir o gráfico.

 

Segue a imagem, em anexo com dizeres..

 

Três duvidas,

1° tem diferença de modelo do excel, porque no excel 2016 eu consegui utilizar porém  deu erro no excel 2010 (e o computador no meu local de trabalho utiliza 2010)

 

2°Em algumas tentativas de utilização da macro a tabela era colada no local onde ponho o e-mail (destinatários), é algo que estou fazendo errado?
Isso costumava acontecer se em algum momento que eu enviei um e-mail anterior e cliquei pela ultima vez nos destinatários.

 

3° Como eu coloco os dizeres no começo do corpo do email?

 

Ps: se tiver como na macro quebra de texto na imagem e ponho do lado da tabela, se não for possível também já tem me ajudado muito

 

[Muca Costa]

3° Como eu coloco os dizeres no começo do corpo do email?

 

Os dizeres Prezados" -> pula duas linhas -> xxxxxxxx

Podem ser incluídos junto com a tabela em F1 e F2 por exemplo

De: ActiveSheet.Range("F3:I31").Select

Para: ActiveSheet.Range("F1:I31").Select