该代码的目的是将一系列单元格保存为桌面上的图片。
文件已创建,但不包含任何单元格数据,它是空白图像,具有相对范围的大小。
该问题出现在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
感谢@Axel Richter指出我该线程:链接
成功的代码如下所示:
' 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
本文收集自互联网,转载请注明来源。
如有侵权,请联系 [email protected] 删除。
我来说两句