I am copying a report dashboard from Excel into Outlook and the sparkline charts in column J do not copy over. When I step through the code it appears that they are being copied and pasted as an image.
When I export the same report to SharePoint as a BMP the sparklines do appear.
I cannot figure out what the issue is. Any help trouble shooting would be appreciated.
*** Edit: The issue appears to be with this line wordDoc.Range.PasteSpecial , , , , wdPasteBitmap
What would be a better paste method that appears clear and not blurry?
The code is shown below:
Sub Mail()
Dim OutApp As Object
Dim OutMail As Object
'Unprotect Scorecard
Worksheets("Scorecard").Unprotect
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "email@email.com>"
.CC = ""
.BCC = ""
.Subject = "Report"
'.HTMLBody =
.Display 'or use .Send
Dim wordDoc As Object
Set wordDoc = OutMail.GetInspector.WordEditor
Worksheets("Scorecard").Activate
Set Plage = ThisWorkbook.Worksheets("Scorecard").Range("B1:M62")
Plage.CopyPicture
With ThisWorkbook.Worksheets("Scorecard").ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)
.Activate
.Chart.Paste
.Chart.ChartArea.Border.LineStyle = xlNone
End With
Worksheets("Scorecard").ChartObjects(Worksheets("Scorecard").ChartObjects.Count).Copy
wordDoc.Range.PasteSpecial , , wdInline, , wdPasteBitmap
Worksheets("Scorecard").ChartObjects(Worksheets("Scorecard").ChartObjects.Count).Delete
Application.CutCopyMode = False
wordDoc.Range.InsertBefore vbLf
wordDoc.Range.InsertBefore vbLf
wordDoc.Hyperlinks.Add Anchor:=wordDoc.Range(0, 0), Address:="http://sharepoint.com", TextToDisplay:="archive"
wordDoc.Range.InsertBefore vbLf
wordDoc.Hyperlinks.Add Anchor:=wordDoc.Range(0, 0), Address:="http://sharepoint.com", TextToDisplay:="web version"
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
'Protect
Worksheets("Scorecard").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub