EXCEL VBA 导出高清图片方法

EXCEL VBA 导出高清图片方法

将EXCEL表格内容另存为图片的方法有很多种，简单的比如“复制为图片格式并另存”，“打印成XPS”等等，本文着重的是利用VBA实现的方法。

该方法适合用于中大型图文表格输出为图片格式，方便传阅，分辨率比直接复制保存要高，在office2010及以上版本最为流畅。

具体看代码：

Sub printA4()
Dim rng As Range  '定义截图范围变量

'm = 200
'ActiveWindow.Zoom = m   '放大视图比例至200%
'网上很多例子喜欢用这个放大视图再截图的方法，来获取高分辨率图片，我觉得不是很好用，也影响VBA运行效率。

'ActiveSheet.PageSetup.PaperSize = xlPaperA3	'网上也有人用放大纸张的方式来截取高清图片，这也不好用。

Set rng = ActiveSheet.Range("Print_Area")	'设置截图范围，我这里设置的是截取“打印区域”，这个方法必须先设置好打印区域（设置打印区域其实就是间接设置了导出图片参照A4/A3的比例）。也可以自定义截图范围，如A1:G10。

rng.CopyPicture xlPrinter, xlPicture	'截图范围复制为图片，用的是CopyPicture命令，参数xlPrinter表示按打印效果复制, 参数xlPicture表示截取为图片格式，包括PNG\TIF等


    With Sheet6.ChartObjects.Add(0, 0, rng.Width * 2, rng.Height * 2).Chart 	'用with简化命令行。在sheet6中新建一个绘图框来保存复制的图片。(放在哪个sheet中没有要求)
        .Parent.Select	'选中新建的绘图框，这是office2016版本新增的要求，没有这句会导致导出的图片是一片空白。
        .Paste  '粘贴复制后的图片
        SaveName = Application.GetSaveAsFilename(InitialFileName:=Year(Date) & Month(Date) & Day(Date) & "数据表A4", filefilter:="图片文件(*.png),*.png")	'弹出保存文件框，以当前日期设置默认文件名（也可以省略这个），不能直接用date函数，否则文件名中可能出现符号“/”导致无法保存。
        If SaveName <> "False" Then .Export SaveName, "PNG"	'如果文件名不为空则导出png格式图片至指定位置
        '.Export "D:\output.png", "png"	这是另一种保存语句
        .Parent.Delete  '删除该临时绘图框
    End With
    
'm = 50
'ActiveWindow.Zoom = m	使用放大视图的方法，在结束时要还原


End Sub