How to copy text and charts in an Excel sheet to Outlook body?

10,860

Perhaps something like this:

Sub createJpg(Namesheet As String, nameRange As String, nameFile As String)
    ThisWorkbook.Activate
    Worksheets(Namesheet).Activate
    Set Plage = ThisWorkbook.Worksheets(Namesheet).Range(nameRange)
    Plage.CopyPicture
    With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With
    Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete
Set Plage = Nothing
End Sub

and within your existing code:

Set appOutlook = CreateObject("outlook.application")
'create a new message
Set Message = appOutlook.CreateItem(olMailItem)
With Message
    .HTMLBody = "Hello" ' and whatever else you need in the text body
    'first we create the image as a JPG file
    Call createJpg("Dashboard", "B8:H9", "DashboardFile")
    'we attached the embedded image with a Position at 0 (makes the attachment hidden)
    TempFilePath = Environ$("temp") & "\"
    .Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue, 0

    'Then we add an html <img src=''> link to this image
    'Note than you can customize width and height - not mandatory

    .HTMLBody = .HTMLBody & "<br><B>WEEKLY REPPORT:</B><br>" _
        & "<img src='cid:DashboardFile.jpg'" & "width='814' height='33'><br>" _
        & "<br>Best Regards,<br>Ed</font></span>"

    .To = "[email protected]; [email protected]"
    .Cc = "[email protected]"

    .Display
    '.Send
End With
Share:
10,860
Admin
Author by

Admin

Updated on June 04, 2022

Comments

  • Admin
    Admin almost 2 years

    I am trying to copy text (Constant Range of Cells) and charts in an excel sheet to an outlook body, however so far I succeeded in copying only charts but not text. I want to know the best way to copy both text (in the selected range) and charts from excel sheet to outlook message. Below is the code I am using now. This code does paste the text but charts are overlapped on the text (when charts are pasted in the email body). I would like to how can I format the outlook email and paste the text and charts without overlapping.

    Sub email_Charts(sFileName, Subject1)
    Dim r As Integer
    Dim o As Outlook.Application
    Dim m As Outlook.MailItem
    Dim wEditor As Word.Document
    Set o = New Outlook.Application
    Dim olTo As String
    
    Windows("Daily_Status_Macro_Ver3.0.xlsm").Activate
    Sheets("Main").Select
    olTo = Worksheets("Main").Cells(3, 3).Value
    
    Windows(sFileName).Activate
    
    msg = "<HTML><font face = Calibri =2>"
    msg = msg & "Hi All, <br><br>"
    msg = msg & "Please find Daily Status Below "
    msg = msg & "<b><font color=#0033CC>"
    msg = msg & Sheets(1).Range("B2:B4")
    
    
        Set m = o.CreateItem(olMailItem)
        m.To = olTo
    
        m.Subject = Subject1
        m.BodyFormat = olFormatHTML
        m.HTMLBody = msg
        m.Display
    
     Windows(sFileName).Activate
     Sheets(1).Select
     ActiveSheet.DrawingObjects.Select
     Selection.Copy
     Set wEditor = o.ActiveInspector.wordeditor
     m.Body = msg
     wEditor.Application.Selection.Paste
     'm.send
    
        Workbooks(sFileName).Close SaveChanges:=False
    End Sub
    
  • Admin
    Admin almost 9 years
    This works and it will paste selected range. I am trying to paste range first and then charts also. This method will just paste text first and then copy my charts above them. I need to give a starting location where my charts has to be pasted so that both pasted charts and pasted range doesn't overlap.
  • Admin
    Admin almost 9 years
    As a workaround I converted the range to picture but didn't copy it to a temp sheet. This way I can copy all charts at once.