从Excel打印到PDF时,自动页面断开

  • 本文关键字:断开 Excel 打印 PDF excel vba
  • 更新时间 :
  • 英文 :


这是我用来自动插入页面断裂时的VBA。如果有多个页面,代码似乎可以工作。但是,如果文档调试器中只有页面,则会给出一个错误

运行时错误9:下标超出范围

指向Set r = PrintVersion.Cells(.Item(pb).Location.Row, 1)。有什么想法是什么问题以及如何修复?

这是我的代码:

    Sub Print()
        Dim Cell As Range
        Dim tempFolderPath As String
        Dim filePath As String
        Dim fileTitle As String
        Dim fnd As Range, r As Range, pb As Variant
        Dim PrintVersion As Worksheet
        Dim WData As Worksheet
        Dim rw As Range, hideRange As Range
        Set PrintVersion = ThisWorkbook.Sheets("Print version")
        Set WData = ThisWorkbook.Sheets("Data")
        With PrintVersion.Range("Print_Area")
                With .Cells.Rows
                    .WrapText = True
                    .VerticalAlignment = xlCenter
                    .EntireRow.AutoFit
                End With
' Hide blank rows with formulas giving as a result ""
        For Each rw In .Rows
            For Each Cell In rw.Cells
                If Cell.HasFormula Then
                    If Cell.Value = "" Then
                        If Not rw.Hidden Then
                            If hideRange Is Nothing Then
                                Set hideRange = rw
                            Else
                                Set hideRange = Union(hideRange, rw)
                            End If
                            Exit For    ' no need to process rest of the row
                       End If
                    End If
                End If
            Next
        Next
        If Not hideRange Is Nothing Then hideRange.EntireRow.Hidden = True
        End With
' Set print area till the last cell
        PrintVersion.PageSetup.PrintArea = PrintVersion.Range("A1:C" & _
        PrintVersion.[LOOKUP(2,1/(C1:C250<>""),ROW(C1:C250))]).Address

           ' make sure sheet is in page break view
            PrintVersion.Parent.Windows(1).View = xlPageBreakPreview
        ' first clear any set page breaks
        PrintVersion.ResetAllPageBreaks
        ' move preposed breaks to top of segement
        With PrintVersion.HPageBreaks
            pb = 1
            Do
                ' check if first column is empty
                Set r = PrintVersion.Cells(.Item(pb).Location.Row, 1)
                If r.Value = "" Then
                    ' find previous cell in column 1 which is not empty
                    Set fnd = PrintVersion.Columns(1).Find("*", r, , , , xlPrevious)
                    ' set page break 1 row above it
                    Set .Item(pb).Location = fnd.Offset(-1, 0)
                    DoEvents
                End If
                pb = pb + 1
                If pb > .Count Then Exit Do
            Loop
        End With
        ' create a path for a temporary file
        tempFolderPath = Environ("Temp")
        fileTitle = "CV_" & Sheets("Filling form").Range("F7") & "_" & Sheets("Filling form").Range("F9")
        filePath = tempFolderPath & "" & fileTitle & ".pdf"
        PrintVersion.ExportAsFixedFormat xlTypePDF, filePath, xlQualityStandard, True, , , , False
        Set PrintVersion = Nothing
        Set WData = Nothing
    End Sub

因此,如果没有任何页面破解,则不需要处理它们,对吗?在进入之前检查是否有:

 With PrintVersion.HPageBreaks
    If .Count > 0 Then
        pb = 1
        Do
            ' check if first column is empty
            Set r = PrintVersion.Cells(.Item(pb).Location.Row, 1)
            If r.Value = "" Then
                ' find previous cell in column 1 which is not empty
                Set fnd = PrintVersion.Columns(1).Find("*", r, , , , xlPrevious)
                ' set page break 1 row above it
                Set .Item(pb).Location = fnd.Offset(-1, 0)
                DoEvents
            End If
            pb = pb + 1
            If pb > .Count Then Exit Do
        Loop
    End If
End With

(未测试(

最新更新