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

D

dcuellar

New Member
Joined
Apr 27, 2015
Messages
42
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?

spyjqd.png


Code: 
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.
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Sort by date Sort by votes
Got it. In case anyone stumbles across this, here is the code I used for it.

Code: 
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
VBA-sending different attachments to different persons
Replies
7
Views
1K
I_know_nuffin
I
E
  • Question
Automatically populate cell after vba email sent
Replies
1
Views
687
eddieum1
E
E
  • Solved
Hiding first column of Email
Replies
3
Views
419
James006
James006
O
  • Question
VBA Email Formatting - Charts and Tables
Replies
0
Views
860
oddzac
O
A
  • Question
Retain hyperlinks in table column after rangetohtml paste for Outlook Email Body table
Replies
1
Views
826
aussiechess
A

Forum statistics

Threads
1,214,950
Messages
6,122,438
Members
449,083
Latest member
Ava19

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top