Logo Hardware.com.br
thiagoqmartins
thiagoqmarti... Novo Membro Registrado
2 Mensagens 0 Curtidas

Envio de Gráficos por e-mail - VBA - Excel

#1 Por thiagoqmarti... 27/05/2020 - 17:55
Olá,

Peguei essa macro (https://www.hardware.com.br/comunidade/email-envio/1296642/) para automatizar um envio de e-mail, porém nela preciso enviar aproximadamente 18 gráficos. Estou escrevendo a sequencia do código, porém em um certo momento o VBA acusa "numero excessivo de continuações de linhas".
Qual seria a solução para executar esse código e enviar os 18 gráficos no corpo do e-mail??

Sub Enviar_Email()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Dim picname As String
Dim Grafico As Chart

ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 1&quot.Activate
Set Grafico = ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 1&quot.Chart
Grafico.Export Filename:="C:\temp\Grafico1.jpg", filtername:="JPG"

ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 2&quot.Activate
Set Grafico = ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 2&quot.Chart
Grafico.Export Filename:="C:\temp\Grafico2.jpg", filtername:="JPG"

ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 3&quot.Activate
Set Grafico = ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 15&quot.Chart
Grafico.Export Filename:="C:\temp\Grafico3.jpg", filtername:="JPG"

ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 4&quot.Activate
Set Grafico = ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 7&quot.Chart
Grafico.Export Filename:="C:\temp\Grafico4.jpg", filtername:="JPG"

ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 5&quot.Activate
Set Grafico = ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 5&quot.Chart
Grafico.Export Filename:="C:\temp\Grafico5.jpg", filtername:="JPG"

ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 6&quot.Activate
Set Grafico = ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 10&quot.Chart
Grafico.Export Filename:="C:\temp\Grafico6.jpg", filtername:="JPG"

ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 7&quot.Activate
Set Grafico = ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 8&quot.Chart
Grafico.Export Filename:="C:\temp\Grafico7.jpg", filtername:="JPG"

ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 8&quot.Activate
Set Grafico = ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 11&quot.Chart
Grafico.Export Filename:="C:\temp\Grafico8.jpg", filtername:="JPG"

ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 9&quot.Activate
Set Grafico = ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 4&quot.Chart
Grafico.Export Filename:="C:\temp\Grafico9.jpg", filtername:="JPG"

ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 10&quot.Activate
Set Grafico = ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 9&quot.Chart
Grafico.Export Filename:="C:\temp\Grafico10.jpg", filtername:="JPG"

ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 11&quot.Activate
Set Grafico = ActiveWorkbook.Sheets("Plan1&quot.ChartObjects("Gráfico 16&quot.Chart
Grafico.Export Filename:="C:\temp\Grafico11.jpg", filtername:="JPG"


Set myOlApp = CreateObject("Outlook.Application&quot
Set myItem = myOlApp.CreateItem(olMailItem)
Set myAttachments = myItem.Attachments

With myItem
.To = "[EMAIL]fulano1@email.com.br[/EMAIL]"
.CC = "[EMAIL]fulano2@email.com.br[/EMAIL];[EMAIL]fulano2@email.com.br[/EMAIL]"
.Subject = " " & ActiveWorkbook.Sheets("Plan1&quot.Range("C4&quot.Value & ""
.HTMLBody = " " & ActiveWorkbook.Sheets("Plan1&quot.Range("C6&quot.Value & "" & _
"<BR><BR>" & _
"<img src='C:\temp\Grafico1.jpg'>" & _
"<BR><BR>" & _
"<img src='C:\temp\Grafico2.jpg'>" & _
"<BR><BR>" & _
"<img src='C:\temp\Grafico3.jpg'>" & _
"<BR><BR>" & _
"<img src='C:\temp\Grafico4.jpg'>" & _
"<BR><BR>" & _
"<img src='C:\temp\Grafico5.jpg'>" & _
"<BR><BR>" & _
"<img src='C:\temp\Grafico6.jpg'>" & _
"<BR><BR>" & _
"<img src='C:\temp\Grafico7.jpg'>" & _
"<BR><BR>" & _
"<img src='C:\temp\Grafico8.jpg'>" & _
"<BR><BR>" & _
"<img src='C:\temp\Grafico9.jpg'>" & _
"<BR><BR>" & _
"<img src='C:\temp\Grafico10.jpg'>" & _
"<BR><BR>" & _
"<img src='C:\temp\Grafico11.jpg'>" & _
"<BR><BR>" & _
"Edson"
.Display
End With

ActiveWorkbook.Save

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub
EdsonBR
EdsonBR Veterano Registrado
274 Mensagens 280 Curtidas
#3 Por EdsonBR
28/05/2020 - 12:44
Bom dia, @thiagoqmartins

Não tenho o Outlook instalado aqui, portanto não tenho como testar, mas uma ideia para refazer seu código acima para mais imagens seria:
Option Explicit
Sub Enviar_Email()
Const olMailItem As Byte = 0
Dim myOlApp As Object, myItem As Object, myAttachments As Object
Dim ws As Worksheet, numGrafs As Variant, tmpBody As String, i As Long
Set ws = ActiveWorkbook.Sheets("Plan1&quot
With Application
.ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False
numGrafs = Array(1, 2, 15, 7, 5, 10, 8, 11, 4, 9, 16)
For i = 0 To UBound(numGrafs)
ws.ChartObjects("Gráfico " & numGrafs(i)).Chart.Export _
Filename:="C:\temp\Grafico" & (i + 1) & ".jpg", _
Filtername:="JPG"
tmpBody = tmpBody & "<BR><BR><img src='C:\temp\Grafico" & (i + 1) & ".jpg'>"
Next i
Set myOlApp = CreateObject("Outlook.Application&quot
Set myItem = myOlApp.CreateItem(olMailItem)
'Set myAttachments = myItem.Attachments
With myItem
.To = "[EMAIL]fulano1@email.com.br[/EMAIL]"
.CC = "[EMAIL]fulano2@email.com.br[/EMAIL];[EMAIL]fulano2@email.com.br[/EMAIL]"
.Subject = " " & ws.Range("C4&quot.Value & ""
.HTMLBody = " " & ws.Range("C6&quot.Value & "" & tmpBody & _
"<BR><BR>" & _
"Edson"
.Display
End With
ActiveWorkbook.Save
.ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True
End With
End Sub


Insira os outros números de figura no array numGrafs, separando-os por vírgula e teste...
© 1999-2024 Hardware.com.br. Todos os direitos reservados.
Imagem do Modal