Charts.Add - Quick Fix, I'm stumped.

[dcuellar]

I have a form that has a command button that will create an e-mail. Within the body of the e-mail is an image of a range. I got it all to work however, I am noticing a white space between the image and the selection area. How do I clean this up?

Private Sub cmdEmail_Click()

Dim WS As Worksheet
Set WS = Worksheets("Exceptions Dashboard")
Dim oRange As Range
Dim oCht As Chart
Dim oImg As Picture

Set oRange = Range("O2:Y31")
Set oCht = Charts.Add
oRange.CopyPicture xlScreen, xlPicture
oCht.Paste
oCht.Export Filename:="C:\Temp\SavedRange.jpg", Filtername:="JPG"


     
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

On Error GoTo cleanup

Set OutMail = OutApp.createItem(0)
On Error Resume Next
With OutMail
.To = Range("'Lists'!M2").Value & ";" & Range("'Lists'!M3").Value & ";" & Range("'Lists'!M4").Value & ";" & Range("'Lists'!M5").Value & ";" & Range("'Lists'!M6").Value & ";" & Range("'Lists'!M7").Value
.CC = Range("'Lists'!M10").Value & ";" & Range("'Lists'!M11").Value & ";" & Range("'Lists'!M12").Value
.Subject = "Exceptions Count Exceeded Threshold - " & Range("'Exceptions Dashboard'!G22").Value
.HTMLBody = "" _
                & "[FONT=Calibri][SIZE=3]" _
                & "Hello,

The exception threshold of  " & Range("'In-Depth Look'!AG61").Value & " has been exceeded by one or more exception types." _
                & "

Below is an overview:


" _
                & "[IMG]http://www.mrexcel.com/forum/Temp\SavedRange.jpg[/IMG]
" _
                & "
Best Regards,
Systems Team[/SIZE][/FONT]"

.Display
End With
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = False


'Close UserForm.
    Unload Me
    
DoEvents
oCht.Delete

End Sub

Essentially, the image needs to be stretched out to fill the whole space.

 

[dcuellar]

Got it. In case anyone stumbles across this, here is the code I used for it.

Private Sub cmdEmail_Click()

Dim lRow As Long
Dim WS As Worksheet
Dim i  As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
Set WS = Worksheets("Threshold Exceeded Log")
lRow = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row


'copy the range as an image
Call Range("'Exceptions Dashboard'!O2:Y31").CopyPicture(xlScreen, xlPicture)



'remove all previous shapes in sheet2
intCount = Sheet2.Shapes.Count
For i = 1 To intCount
    Sheet2.Shapes.Item(1).Delete
Next i
'create an empty chart in sheet2
Sheet2.Shapes.AddChart
'activate sheet2
Sheet2.Activate
'select the shape in sheet2
Sheet2.Shapes.Item(1).Select
Set objChart = ActiveChart
'paste the range into the chart
Sheet2.Shapes.Item(1).Line.Visible = msoFalse
Sheet2.Shapes.Item(1).Width = Range("'Exceptions Dashboard'!O2:Y31").Width
Sheet2.Shapes.Item(1).Height = Range("'Exceptions Dashboard'!O2:Y31").Height
objChart.Paste
'save the chart as a JPEG
objChart.Export Filename:="C:\Temp\SavedRange.jpg", Filtername:="JPG"
     
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

On Error GoTo cleanup

Set OutMail = OutApp.createItem(0)
On Error Resume Next
With OutMail
.To = Range("'Lists'!M2").Value & ";" & Range("'Lists'!M3").Value & ";" & Range("'Lists'!M4").Value & ";" & Range("'Lists'!M5").Value & ";" & Range("'Lists'!M6").Value & ";" & Range("'Lists'!M7").Value
.CC = Range("'Lists'!M10").Value & ";" & Range("'Lists'!M11").Value & ";" & Range("'Lists'!M12").Value
.Subject = "Exceptions Count Exceeded Threshold - " & Range("'Exceptions Dashboard'!G22").Value
.HTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "Hello,<br /><br />The exception threshold of  " & Range("'In-Depth Look'!AG61").Value & "% has been exceeded by one or more exception types." _
                & "<br /><br />Below is an overview:<br /><br /><br />" _
                & "<IMG alt='' hspace=0 src='C:\Temp\SavedRange.jpg' align=baseline border=0 /><br />" _
                & "<br />Best Regards,<br /><br />" & Range("'Exceptions Dashboard'!G20").Value & "</font></span>"

.Display
End With

With WS
         NER = .Cells(.Rows.Count, "I").End(xlUp).Row
        .Cells(lRow, 1).Value = Range("'Exceptions Dashboard'!G28").Value
        .Cells(lRow, 2).Value = Range("'Exceptions Dashboard'!G24").Value
        .Cells(lRow, 3).Value = Range("'Exceptions Dashboard'!I24").Value
        .Cells(lRow, 4).Value = Range("'Exceptions Dashboard'!G20").Value
        .Cells(lRow, 5).Value = Range("'Exceptions Dashboard'!G22").Value
        .Cells(lRow, 6).Value = Range("'Exceptions Dashboard'!X8").Value
        .Cells(lRow, 7).Value = Range("'Exceptions Dashboard'!S8").Value
        .Cells(lRow, 8).Value = Range("'Exceptions Dashboard'!V8").Value
        .Cells(lRow, 10).Value = Range("'Exceptions Dashboard'!X10").Value
        .Cells(lRow, 11).Value = Range("'Exceptions Dashboard'!S10").Value
        .Cells(lRow, 12).Value = Range("'Exceptions Dashboard'!V10").Value
        .Cells(lRow, 14).Value = Range("'Exceptions Dashboard'!X12").Value
        .Cells(lRow, 15).Value = Range("'Exceptions Dashboard'!S12").Value
        .Cells(lRow, 16).Value = Range("'Exceptions Dashboard'!V12").Value
        .Cells(lRow, 18).Value = Range("'Exceptions Dashboard'!X14").Value
        .Cells(lRow, 19).Value = Range("'Exceptions Dashboard'!S14").Value
        .Cells(lRow, 20).Value = Range("'Exceptions Dashboard'!V14").Value
        .Cells(lRow, 22).Value = Range("'Exceptions Dashboard'!X16").Value
        .Cells(lRow, 23).Value = Range("'Exceptions Dashboard'!S16").Value
        .Cells(lRow, 24).Value = Range("'Exceptions Dashboard'!V16").Value
        .Cells(lRow, 26).Value = Range("'Exceptions Dashboard'!X18").Value
        .Cells(lRow, 27).Value = Range("'Exceptions Dashboard'!S18").Value
        .Cells(lRow, 28).Value = Range("'Exceptions Dashboard'!V18").Value
        .Cells(lRow, 30).Value = Range("'Exceptions Dashboard'!X20").Value
        .Cells(lRow, 31).Value = Range("'Exceptions Dashboard'!S20").Value
        .Cells(lRow, 32).Value = Range("'Exceptions Dashboard'!V20").Value
        .Cells(lRow, 34).Value = Range("'Exceptions Dashboard'!X22").Value
        .Cells(lRow, 35).Value = Range("'Exceptions Dashboard'!S22").Value
        .Cells(lRow, 36).Value = Range("'Exceptions Dashboard'!V22").Value
        .Cells(lRow, 38).Value = Range("'Exceptions Dashboard'!X24").Value
        .Cells(lRow, 39).Value = Range("'Exceptions Dashboard'!S24").Value
        .Cells(lRow, 40).Value = Range("'Exceptions Dashboard'!V24").Value
        
    .Range("I" & NER).Copy
    .Range("I" & NER + 1).PasteSpecial xlPasteFormulas
    .Range("M" & NER).Copy
    .Range("M" & NER + 1).PasteSpecial xlPasteFormulas
    .Range("Q" & NER).Copy
    .Range("Q" & NER + 1).PasteSpecial xlPasteFormulas
    .Range("U" & NER).Copy
    .Range("U" & NER + 1).PasteSpecial xlPasteFormulas
    .Range("Y" & NER).Copy
    .Range("Y" & NER + 1).PasteSpecial xlPasteFormulas
    .Range("AC" & NER).Copy
    .Range("AC" & NER + 1).PasteSpecial xlPasteFormulas
    .Range("AG" & NER).Copy
    .Range("AG" & NER + 1).PasteSpecial xlPasteFormulas
    .Range("AK" & NER).Copy
    .Range("AK" & NER + 1).PasteSpecial xlPasteFormulas
    .Range("AO" & NER).Copy
    .Range("AO" & NER + 1).PasteSpecial xlPasteFormulas
    
    Application.CutCopyMode = False

End With

On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = False


'Close UserForm.
    Unload Me
    
DoEvents
Sheet2.Shapes.Item(1).Delete


End Sub