根据打印区域中分页符把Excel中打印区域按预览的页面批量转化为图片并导出

kai120690

我是想根据打印区域中分页符把Excel中打印区域按预览的页面批量转化为图片并导出
运行下面的代码会提示.PrintArea类型不匹配，求大神帮我修改下，感谢

Sub ExportPrintAreaAsImage()
    Dim ws As Worksheet
    Dim printArea As Range
    Dim pageBreak As Range
    Dim i As Integer
    Dim savePath As String
   
    ' 设置保存路径
    savePath = "C:\Temp\"
   
    ' 循环遍历每个工作表
    For Each ws In ThisWorkbook.Worksheets
        ' 获取当前工作表的打印区域
        Set printArea = ws.PageSetup.PrintArea
        
        If Not printArea Is Nothing Then
            ' 循环遍历每个分页符
            For i = 1 To ws.HPageBreaks.Count + 1
                ' 获取当前分页符之前的打印区域
                If i = 1 Then
                    Set printArea = ws.Range(printArea.Cells(1), ws.HPageBreaks(i).Location.Offset(-1))
                Else
                    Set printArea = ws.Range(ws.HPageBreaks(i - 1).Location.Offset(1), ws.HPageBreaks(i).Location.Offset(-1))
                End If
               
                ' 隐藏网格线和标题栏
                ws.Rows(1).Hidden = True
                ws.PageSetup.PrintGridlines = False
               
                ' 设置打印区域并打印到图片
                ws.PageSetup.PrintArea = printArea.Address
                ws.ExportAsFixedFormat Type:=xlTypePicture, Filename:=savePath & ws.Name & "_" & i & ".jpg", Quality:=xlQualityStandard, _
                                       IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            Next i
            
            ' 恢复打印区域设置
            ws.PageSetup.PrintArea = printArea.Address
            
            ' 显示网格线和标题栏
            ws.Rows(1).Hidden = False
            ws.PageSetup.PrintGridlines = True
        End If
    Next ws
   
    MsgBox "导出完成！", vbInformation
End Sub

kurama1982

在Excel VBA中，PrintArea是一个字符串，表示工作表的打印区域。在你的代码中，你尝试将printArea声明为Range对象，这会导致类型不匹配的错误。

为了解决这个问题，你需要将printArea声明为String类型，并使用PrintArea属性来获取工作表的打印区域字符串。以下是修改后的代码：

Sub ExportPrintAreaAsImage()
    Dim ws As Worksheet
    Dim printArea As String
    Dim pageBreak As Range
    Dim i As Integer
    Dim savePath As String
   
    ' 设置保存路径
    savePath = "C:\Temp\"
   
    ' 循环遍历每个工作表
    For Each ws In ThisWorkbook.Worksheets
        ' 获取当前工作表的打印区域
        printArea = ws.PageSetup.PrintArea
        
        If Not printArea = "" Then
            ' 循环遍历每个分页符
            For i = 1 To ws.HPageBreaks.Count + 1
                ' 获取当前分页符之前的打印区域
                If i = 1 Then
                    Set printRange = ws.Range(printArea).Resize(ws.HPageBreaks(i).Location.Row - 1 - ws.Range(printArea).Row)
                Else
                    Set printRange = ws.Range(ws.HPageBreaks(i - 1).Location.Offset(1)).Resize(ws.HPageBreaks(i).Location.Row - 1 - ws.Range(ws.HPageBreaks(i - 1).Location.Offset(1)).Row)
                End If
               
                ' 隐藏网格线和标题栏
                ws.Rows(1).Hidden = True
                ws.PageSetup.PrintGridlines = False
               
                ' 设置打印区域并打印到图片
                ws.PageSetup.PrintArea = printArea
                printRange.ExportAsFixedFormat Type:=xlTypePicture, Filename:=savePath & ws.Name & "_" & i & ".jpg", Quality:=xlQualityStandard, _
                                               IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            Next i
            
            ' 恢复打印区域设置
            ws.PageSetup.PrintArea = printArea
            
            ' 显示网格线和标题栏
            ws.Rows(1).Hidden = False
            ws.PageSetup.PrintGridlines = True
        End If
    Next ws
   
    MsgBox "导出完成！", vbInformation
End Sub

商朝电工

一直想学VBA，一直没开始学

kai120690

kurama1982 发表于 2023-12-6 13:38
在Excel VBA中，PrintArea是一个字符串，表示工作表的打印区域。在你的代码中，你尝试将printArea声明为Ran ...

还是运行不成功，这是我的测试文档 ，能否再帮忙看下，感谢！https://wormhole.app/QPvRl#7VcvYN0kh3xuSdaWtBMc_g

kurama1982

1.将声明 Dim printArea As Range 改为 Dim printAreas As Areas。这样可以使用 Areas 对象来表示打印区域中的多个区域。

2.在获取打印区域时，将 Set printArea = ws.PageSetup.PrintArea 改为 Set printAreas = ws.PageSetup.PageAreas。这样可以获取打印区域的所有区域。

3.在设置打印区域并打印到图片之前，需要使用 printAreas.Areas(i) 来获取每个分页符之前的打印区域。

cybpcdh

大佬神技