Sub SaveRangeAsImage()
Dim rng As Range Dim chartObj As ChartObject Dim fileName As String
'设置范围和文件名 Set rng = Range("A1:B3") fileName = "D:\range.png"
'创建图表对象 Set chartObj = ActiveSheet.ChartObjects.Add(0, 0, rng.Width, rng.Height) chartObj.Activate
'将范围复制到图表对象中 rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture chartObj.Chart.Paste
'保存为图片 chartObj.Chart.Export fileName, "PNG"
'延迟1秒 Application.Wait (Now + TimeValue("0:00:01"))
'删除图表对象 chartObj.Delete
End Sub