Excel·VBA工作表导出为图片

工作表导出为图片"/>

Excel·VBA工作表导出为图片

《Excel转图片别再截图啦！用这4个方法，高清且无损！》，excel转为图片一般方法较为简单，那么能否使用vba将excel转为图片

选中区域导出为图片

zoom设置为2，导出图片较为清晰

Sub 选中区域导出为图片()Dim zoom#, rng As Range, save_name$zoom = 2: Set rng = Selection  '图片缩放倍数；设置截图范围为选中区域rng.CopyPicture xlPrinter, xlPicture  '截图范围复制为图片With ActiveSheet.ChartObjects.Add(0, 0, rng.Width * zoom, rng.Height * zoom).Chart  '新建一个临时图表区，用来储存图片.Parent.Select  '选中新建的绘图框，office2016版本新增要求，缺少会导致导出的图片是一片空白.Paste          '粘贴复制后的图片'显示标准的“另存为”对话框，获取用户文件名，InitialFilename可指定文件名，FileFilter筛选条件save_name = Application.GetSaveAsFilename(InitialFileName:="导出图片" & Format(Date, "yyyymmdd"), filefilter:="图片文件(*.png),*.png")If save_name <> "False" Then .Export save_name, "PNG"  '文件名不为空则导出png图片至指定位置，取消即为False.Parent.Delete  '删除该临时绘图框End With
End Sub

举例

选中单元格区域，运行代码导出为图片，以《Excel·VBA制作工资条》为例

选择导出图片的保存位置、文件名

保存成功的图片

工作簿导出为图片

Sub 工作簿导出为图片()'工作簿所有工作表导出为图片，工作表命名，导出到固定路径Dim zoom#, rng As Range, save_path$, sht As Worksheet, fso As Objectzoom = 2    '图片缩放倍数Set fso = CreateObject("Scripting.FileSystemObject")With ActiveWorkbooksave_path = .path + "\导出图片\"If Not fso.FolderExists(save_path) Then fso.CreateFolder (save_path)For Each sht In .WorksheetsSet rng = sht.UsedRangerng.CopyPicture xlPrinter, xlPictureWith sht.ChartObjects.Add(0, 0, rng.Width * zoom, rng.Height * zoom).Chart.Parent.Select.Paste.Export save_path & sht.Name & ".png", "png"  '导出到固定路径.Parent.DeleteEnd WithNextEnd With
End Sub

举例

以《Excel·VBA制作工资条》和《Excel·VBA单元格区域数据对比差异标记颜色》共4个工作表同在1个工作簿为例，导出结果