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
erro linhas email excel numero macro excessivo vba mail codigo enviar envio graficos macro automatizar vba
EdsonBR
EdsonBR Veterano Registrado
273 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...
LinkedIn
© 1999-2024 Hardware.com.br. Todos os direitos reservados.
Imagem do Modal