1

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
braX
  • 11,506
  • 5
  • 20
  • 33

1 Answers1

0

This is the work around I came up with but I am not stoked. Would prefer to use wdPasteBitmap as the formatting is a little cleaner but I cannot figure out why it is dropping the sparklines.

wordDoc.Range.PasteAndFormat wdChartPicture
wordDoc.Application.ActiveDocument.InlineShapes(1).Width = 850
wordDoc.Application.ActiveDocument.InlineShapes(1).Height = 950