Saving range as picture with Excel 2016

问题

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

回答1:

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

来源：https://stackoverflow.com/questions/48399832/saving-range-as-picture-with-excel-2016