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 Object
    zoom = 2    '图片缩放倍数
    Set fso = CreateObject("Scripting.FileSystemObject")
    With ActiveWorkbook
        save_path = .path + "\导出图片\"
        If Not fso.FolderExists(save_path) Then fso.CreateFolder (save_path)
        For Each sht In .Worksheets
            Set rng = sht.UsedRange
            rng.CopyPicture xlPrinter, xlPicture
            With sht.ChartObjects.Add(0, 0, rng.Width * zoom, rng.Height * zoom).Chart
                .Parent.Select
                .Paste
                .Export save_path & sht.Name & ".png", "png"  '导出到固定路径
                .Parent.Delete
            End With
        Next
    End With
End Sub