VBA to email a selected range as a picture

[shophoney]

Hi I have a sheet "Email MTD Recap" that we email the range "B2:G24". But for some reason the sheet looses all formating, hidden rows... using Airmail for iOS only. They havent been able to figure things out. Works perfect in all other mobile and desktop apps.

So my solution for now would be to send the selected range as a picture to be viewed on their phones. But I'm having issues with the code.

Below is what we use already what do i need to change to have it send it as a picture?

Sub Send_Range_EmailMTDRecap_with_MailEnvelope()
'Working in Excel 2002-2016
Dim AWorksheet As Worksheet
Dim Sendrng As Range
Dim rng As Range


On Error GoTo StopMacro


With Application
.ScreenUpdating = False
.EnableEvents = False
End With


'Fill in the Worksheet/range you want to mail
'Note: if you use one cell it will send the whole worksheet
Set Sendrng = Worksheets("EMAIL MTD RECAP").Range("B2:G24")


'Remember the activesheet
Set AWorksheet = ActiveSheet


With Sendrng


' Select the worksheet with the range you want to send
.Parent.Select


'Remember the ActiveCell on that worksheet
Set rng = ActiveCell


'Select the range you want to mail
.Select


' Create the mail and send it
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope


' Set the optional introduction field thats adds
' some header text to the email body.
.Introduction = "Hi below is the MTD recap comparing TY vs. LY and same stores YOY."


With .Item
.To = "Steve@apple.com"
.CC = ""
.BCC = ""
.Subject = "MTD RECAP " & Format(Date, "MMMM DD/YY")
.Send
End With


End With


'select the original ActiveCell
rng.Select
End With


'Activate the sheet that was active before you run the macro
AWorksheet.Select


StopMacro:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveWorkbook.EnvelopeVisible = False


End Sub


Thanks.

PS we also use CDO to hide the sent emails fro staff. I can add that code to it after.

 

[Haluk]

Related with saving range B2:G24 as a picture file, the following code will do this and export this range as a GIF file and will prompt the user.

Afterwards you can use your own code to send this GIF file as an attachment.

Hope this helps,

Sub Save_Range_As_GIF()
    Dim MyChart As Chart
    Dim objPict As Object
    Dim RgCopy As Range
    
    Range("B2:G24").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    ActiveSheet.PasteSpecial Format:="Bitmap"
    Set objPict = Selection
        
    objPict.CopyPicture 1, 1
    Set MyChart = ActiveSheet.ChartObjects.Add(1, 1, objPict.Width + 10, objPict.Height + 10).Chart
    
    With MyChart
        .Paste
        .Export ThisWorkbook.Path & Application.PathSeparator & "Temp.gif"
        .Parent.Delete
    End With
    
    MsgBox ThisWorkbook.Path & Application.PathSeparator & "Temp.gif" & " is created !"
    
    objPict.Delete
    Set objPict = Nothing
End Sub

 

[shophoney]

Hi. I must be doing something wrong. All i see is a GIF file that's blank?

 

[Haluk]

Did you place the code into the workbook that you want to export the data as a picture file ?

Make sure that the sheet that you want to export data is the active sheet, before running the code.

 

[shophoney]

Hi. Yes i checked it is in the correct spot. So it just grabs a blank chart. I've even stepped through the code.

 

[Haluk]

Try to change the line;

ActiveSheet.PasteSpecial Format:="Bitmap"

to;

ActiveSheet.PasteSpecial , xlBitmap