2

The purpose of this code is to save a range of cells as a picture on the desktop.

The file is created but does not contain any of the cell data, it is a blank image with the relative size of the range.

The problem appears in Office 2016. Works in 2013.

Sub SendSnapshot2()

    Dim strRng As Range
    Dim strPath As String
    Dim strFile As String
    Dim Cht As Chart

    Set strRng = ActiveWorkbook.Sheets("Snapshot").Range("A2:Q31")
    strPath = CreateObject("WScript.Shell").specialfolders("Desktop")
    strFile = "HeartBeat Snapshot - " & Format(Now(), "yyyy.mm.dd.Hh.Nn") & ".png"

    strRng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    'strRng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    'strRng.CopyPicture xlScreen, xlBitmap

    Application.DisplayAlerts = False
    Set Cht = Charts.Add
    With Cht
        .Paste
        '.Export Filename:=strFile, Filtername:="JPG"
        .Export Filename:="C:\downloads\SavedRange.jpg", Filtername:="JPG"
        '.Delete
    End With

End Sub
Community
  • 1
  • 1
Armitage2k
  • 1,164
  • 2
  • 27
  • 59
  • So the problem is with saving the file, and not with the email right? i.e. After `cht.Chart.Export strPath & "\" & strFile`, is the file created on your computer also a blank image? If that's the case, maybe consider reducing the scope of your question to exclude the email half. As a debugging step, I would check `cht` after `cht.Chart.Paste` to see if it's blank in Excel before you export it. – Dan Jan 23 '18 at 10:57
  • Correct. The image is saved, however the image is blank. My guess is that there is a problem with the conversion of the cell content to an image. Not sure how to go about this TBH... – Armitage2k Jan 23 '18 at 10:58
  • I suggest editing your question then, leave off everything about the email and be clear that the image is saving as a blank. – Dan Jan 23 '18 at 11:03
  • I think it is rather clear already from the problem description that I have given. I rather keep the whole code in case any solution requires changes to the email segment later. I trust the problem is explained clearly enough, lets see what solutions come back. – Armitage2k Jan 23 '18 at 11:05
  • Have you tried passing different argument to `.CopyPicture` like `.CopyPicture Appearance:=xlScreen, Format:=xlBitmap` or `.CopyPicture Appearance:=xlScreen, Format:=xlPicture` – Dan Jan 23 '18 at 11:07
  • Not sure of the answer - Ron de Bruin has a fair amount about email workbooks/ranges on his website. Was just commenting to say you don't need `Activeworkbook.Application.Screenupdating....`, just `Application.Screenupdating....` will do it (`ActiveWorkbook.Application` & `Application` will both point to Excel). – Darren Bartrup-Cook Jan 23 '18 at 11:14
  • Please provide a MINIMAL example of your code. Reproducing only the error, not everything that does work. That will greatly help you narrowing down your question, and help us answer it. – Luuklag Jan 23 '18 at 11:25
  • Thanks. I did some more googling and used other solutions from SE which didnt work either. The problem seems to be related to the `strRng.CopyPicture' bit since `cht` is also empty. Perhaps something in O2016 changed? – Armitage2k Jan 23 '18 at 11:26
  • code updated. For reference, neither of those solutions mentioned here (https://stackoverflow.com/questions/16143877/using-vba-code-how-to-export-excel-worksheets-as-image-in-excel-2003) seem to work either. must be a change from Office 2003 to 2016 – Armitage2k Jan 23 '18 at 11:29
  • 1
    See https://stackoverflow.com/questions/42091390/vba-range-to-jpg-picture/42092375#42092375 – Axel Richter Jan 23 '18 at 11:59
  • @AxelRichter Thank you, that solved it. – Armitage2k Jan 23 '18 at 12:18

1 Answers1

3

Thanks to @Axel Richter who pointed me over to this thread: Link

The successful code looks like this:

' convert snapshot to picture
strRng.CopyPicture xlScreen, xlPicture
lWidth = strRng.Width
lHeight = strRng.Height

Set Cht = ActiveSheet.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)
Cht.Activate
With Cht.Chart
  .Paste
  .Export Filename:=strPath & "\" & strFile, Filtername:="JPG"
End With

Cht.Delete
Armitage2k
  • 1,164
  • 2
  • 27
  • 59