如何修改VBA代码实现Excel所有工作表批量导出为同名同尺寸JPG

完整可运行代码 #

Sub ExportSheetsToJPG()
    Dim ws As Worksheet, wb As Workbook
    Dim fDialog As FileDialog, exportPath As String
    Dim tmpChart As ChartObject, img As Shape
    ' 可自行调整以下两个参数修改导出图片的统一尺寸，单位为磅
    Const FixedWidth As Long = 1200
    Const FixedHeight As Long = 800
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 选择导出目录
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    fDialog.Title = "选择JPG图片导出目录"
    fDialog.InitialFileName = ThisWorkbook.Path
    If fDialog.Show <> -1 Then
        MsgBox "未选择导出目录，程序退出"
        GoTo Cleanup
    End If
    exportPath = fDialog.SelectedItems(1) & "\"
    
    ' 新建临时工作簿处理静态内容
    Set wb = Workbooks.Add
    wb.Sheets(1).Name = "Tmp123"
    For Each ws In ThisWorkbook.Worksheets
        ws.Copy After:=wb.Sheets(wb.Sheets.Count)
    Next ws
    wb.Sheets("Tmp123").Delete
    
    ' 遍历处理每个工作表并导出
    For Each ws In wb.Worksheets
        ' 复制工作表内容转成图片
        ws.Range(ws.Cells(1, 1), ws.Cells.SpecialCells(xlLastCell)).Copy
        ws.Cells(1, 1).Select
        ws.Pictures.Paste
        Set img = ws.Shapes(ws.Shapes.Count)
        
        ' 统一设置图片尺寸
        img.LockAspectRatio = msoFalse
        img.Width = FixedWidth
        img.Height = FixedHeight
        
        ' 导出图片为JPG
        img.Copy
        Set tmpChart = ws.ChartObjects.Add(0, 0, img.Width, img.Height)
        tmpChart.Chart.Paste
        tmpChart.Chart.Export Filename:=exportPath & ws.Name & ".jpg", FilterName:="JPG"
        tmpChart.Delete
        
        ' 清除工作表内容
        ws.Cells.Clear
        ws.Shapes.Delete
    Next ws
    
    ' 原有保存静态工作簿逻辑，不需要可直接删除
    Set fDialog = Application.FileDialog(msoFileDialogSaveAs)
    fDialog.Title = "保存静态工作簿"
    fDialog.InitialFileName = ThisWorkbook.Path
    If fDialog.Show = -1 Then
        wb.SaveAs fDialog.SelectedItems(1)
    End If
    
Cleanup:
    wb.Close SaveChanges:=False
    Set wb = Nothing
    Set fDialog = Nothing
    Set tmpChart = Nothing
    Set img = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

功能说明 #

• 支持一键批量导出当前工作簿所有工作表为JPG格式
• 自动以对应工作表名称作为导出图片的文件名
• 可通过修改代码开头的FixedWidth和FixedHeight参数统一调整所有导出图片的尺寸
• 内置文件夹选择对话框，无需手动修改代码指定导出路径
• 保留原代码生成静态图片工作簿的功能，不需要可直接删除对应代码段

运行注意事项 #

• 运行宏前请先保存当前工作簿，避免路径读取异常
• 若工作表内容超出设定的固定尺寸，可适当调大FixedWidth和FixedHeight参数避免内容裁切
• 导出的JPG默认采用最高质量，如需压缩可在Export方法中添加质量参数调整

内容的提问来源于stack exchange，提问作者Markus Bücher