Автоматические разрывы страниц при печати в PDF из Excel

Question

Вот VBA, которую я использую для автоматической вставки разрывов страниц при печати в PDF.Код, кажется, работает, если есть более одной страницы.Однако, если в отладчике документа есть только страница, выдается ошибка

Ошибка времени выполнения 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

Answer 1

Итак, если нет разрывов страниц, вам не нужно обрабатывать их, верно? Проверьте, есть ли какие-либо, прежде чем идти в это:

 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

(не тестировалось)