使用Excel 2016将图片保存为图片

时间:2018-01-23 10:49:32

标签: excel vba excel-vba

此代码的目的是将一系列单元格保存为桌面上的图片。

文件已创建但不包含任何单元格数据,它是一个空白图像,其范围的相对大小。

问题出现在Office 2016中。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 个答案:

答案 0 :(得分:0)

感谢@Axel Richter,他向我指出了这个帖子:Link

成功的代码如下所示:

' 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