Body of email with Pivot table Range as Picture format.

[Guna13]

Hello,

Would it be possible to send an email with an attachment that also contains a Pivot table for the second sheet (range A1 to M20) as a picture in the body of the email?

Below is an Excel file for each range in the email body

 

[HongRu]

Try.

By the code below, we can have a jpg file, and then attach it to the mail.

The code is from
ExcelVBA 將Range內容拷貝成圖表，轉成圖片 | 資訊學習心得隨寫 - 點部落

Sub sbCopyToPic()
    'ScreenUpdating must be True
    Application.ScreenUpdating = True
    'Set Range you want to export to file
    Dim rgExp As Range: Set rgExp = Worksheets(2).Range("A1:M20")
    'Copy range as picture onto Clipboard
    rgExp.CopyPicture Appearance:=xlScreen, Format:=xlPrinter
    'Create an empty chart with exact size of range copied
    With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
                                      Width:=rgExp.Width, Height:=rgExp.Height)
        .Name = "myChart"
        .Activate
    End With
    'Paste into chart area, export to file, delete chart.
    ActiveChart.Paste
    ActiveSheet.ChartObjects("myChart").Chart.Export ThisWorkbook.Path & "\testmeExportChart.jpg"
    ActiveSheet.ChartObjects("myChart").Delete
End Sub

 

[Guna13]

Hi

Try.

By the code below, we can have a jpg file, and then attach it to the mail.

The code is from
ExcelVBA 將Range內容拷貝成圖表，轉成圖片 | 資訊學習心得隨寫 - 點部落

Sub sbCopyToPic()
    'ScreenUpdating must be True
    Application.ScreenUpdating = True
    'Set Range you want to export to file
    Dim rgExp As Range: Set rgExp = Worksheets(2).Range("A1:M20")
    'Copy range as picture onto Clipboard
    rgExp.CopyPicture Appearance:=xlScreen, Format:=xlPrinter
    'Create an empty chart with exact size of range copied
    With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
                                      Width:=rgExp.Width, Height:=rgExp.Height)
        .Name = "myChart"
        .Activate
    End With
    'Paste into chart area, export to file, delete chart.
    ActiveChart.Paste
    ActiveSheet.ChartObjects("myChart").Chart.Export ThisWorkbook.Path & "\testmeExportChart.jpg"
    ActiveSheet.ChartObjects("myChart").Delete
End Sub

But my requirment is different, this each List of attachment file will send One by one, also those attachment Pivot table Range data copy and paste in body of email as shows above format.
this is my code.. but how to bring each attachment Pivot table data in body of email

Public Sub SendEmailbyList()
    '----define parameter
    Dim iRows As Long, iCounter As Long, Att As String, mailBody As String, Subj As String
    Dim i As Long, j As Long, mailUser As String, tStr As String, mailTo As String, tBL As Boolean
    
    UserForm1.Hide
    
    Sheets("SendEmail").Select
    
    With Sheets("SendEmail")
        iRows = .Range("A65536").End(xlUp).row
        If iRows < 6 Then
            MsgBox "No site list,check and try again": Exit Sub
        End If
        'Subj = "tkey - ETB Excel File"
        For i = 6 To iRows
            mailUser = .Range("B" & i).Value 'ME_Financial file name,begin with "ETB"
            Finc = Sheets("SendEmail").Cells(i, 1).Value
            Strc = Now
            mailTo = .Range("C" & i).Value
            Subj = "Month_End_Financial - " & Finc & " - " & "System Generate Testing File" & " - " & Strc
            Subj = Finc & " - " & "ETB Excel File" & " - " & Strc
            Att = .Range("D" & i).Value 'attachment
            mailBody = CemailBody(mailUser) ' get eamil boay
            tBL = sendMails(mailTo, Subj, mailBody, Att)
            Range("E" & i).Value = "Sent"
         Next i
    End With
    MsgBox "Email Sent", vbInformation
    
End Sub
   
'---email Body
Public Function CemailBody(User As String) As String
    Dim Body As String
    Body = ""
   Body = Body & "<DIV Style='font-size:10.0pt;font-family:Century Gothic;'>"
    Body = Body & "Hi " & User & ",<br/><br/>"
    Body = Body & "Please find attachment Extended Trial Balance (ETB), " & Finc
    Body = Body & "Any question,  Kindly contact the below Group ID for any Technical Support." _
                & "<br/>" & "<br/>"
             
        Body = Body & "<ul><li>" & "#IN - GBS CHE GL Tech Admin Team <in.gbschegltechadminteam@Gmail.com>" & "</ul></li>"
        'Body = Body & "<ul><li>" & "Gunasekaran Seshachalam @gunasekaran.seshachalam@Gmail.com" & "</ul></li>"
        'Body = Body & "Gunasekaran Seshachalam @gunasekaran.seshachalam@Gmail.com" & "</li></ul></ul>"
    
    Body = Body & "Best Regards" & "<br/>"
    Body = Body & "GL Tech Admin Team" & "<br/>"
               ' & "<br/>"
    'Body = Body & "Font Color</span style=""color:#80BFFF" > "<p align=""center"">" & "***Do not reply to this Email, This is an Auto-Generated Email ***" & "<br/>" & "</p>"
    Body = Body & "<p align=""center"">" & "<span style=""color:#80BFFF"">***Do not reply to this Email, This is an Auto-Generated Email***</span style=""color:#80BFFF""><br />"
       
    Body = Body & "</DIV>"
    CemailBody = Body
       
    
        
End Function
'---email sending
Public Function sendMails(strTo As String, strSubject As String, strBody As String, strFileName As String) As Boolean
On Error GoTo errHandle
          Dim oOutlookApp   As New Outlook.Application
          Dim oItemMail     As Outlook.MailItem
          Set oItemMail = oOutlookApp.CreateItem(olMailItem)
          On Error GoTo errHandle
          With oItemMail
          
          
                  '.Recipients
                  .SentOnBehalfOfName = Sheets("SendEmail").Cells(1, 8).Text
                  .To = strTo
                  .Subject = strSubject
                  .BodyFormat = olFormatHTML
                  .HTMLBody = strBody
                  '---attachment
                  If Len(strFileName) > 0 Then .Attachments.Add (strFileName)
                  
                  '.Importance = olImportanceHigh
                  .Sensitivity = olPersonal
                  .Display
                  '.Send
          End With
          sendMails = True
          Exit Function
errHandle:
          SendMail = False
End Function

 

[HongRu]

I think you should amend and test the code by yourself.

Here are some advices for you.
1.
In your Public Sub SendEmailbyList, you have Att = .Range("D" & i).Value.
The "Att" may set to "testmeExportChart.jpg" according to my code, and you should also consider about the file path.

2.
Maybe you can put my code before "Att".
for example,

call sbCopyToPic
Att = .Range("D" & i).Value 'Here you should amend according to your need.

3.
From you code, I can't figure out what's the difference of the Pivot Pictures between mails.

 

[Guna13]

I think you should amend and test the code by yourself.

Here are some advices for you.
1.
In your Public Sub SendEmailbyList, you have Att = .Range("D" & i).Value.
The "Att" may set to "testmeExportChart.jpg" according to my code, and you should also consider about the file path.

2.
Maybe you can put my code before "Att".
for example,

call sbCopyToPic
Att = .Range("D" & i).Value 'Here you should amend according to your need.

3.
From you code, I can't figure out what's the difference of the Pivot Pictures between mails.

In my code, I dont know and didnt any write that pivot table range. thats why i came here to ask question..