Блог

Я пытаюсь настроить лист Excel примерно с 3000 строками для удобной печати в PDF-файле. Я пытаюсь настроить страницу так, чтобы она соответствовала ширине 1 страницы, и я хочу изменить горизонтальные разрывы страниц в соответствии с номерами строк, хранящихся в массиве PgBreakRowsArr .

После запуска прилагаемой подпрограммы разрывы страниц настроены нормально, но ширина печати сократилась с ~ 85% до ~ 45%, а размер печати составляет около 50% от размера страницы.

Есть идеи?

Код

 Option Explicit


Sub SetFriendlyPrintArea(Sht As Worksheet)

'======================================================================================================================
' Description : Sub sets the Friendly Print Area.
'               It loop through 'PgBreakRowsArr' array, and per rows stored inside sets the page breaks.
'
' Argument(s) : sht As Worksheet
'
' Caller(s)   : Sub RawDataToByTimeReport (Excel_to_byTime_Report Module)
'======================================================================================================================

Dim LastRow As Long, i As Long
Dim VerticalPageCount As Long, HPageBreakIndex As Long

HPageBreakIndex = 1 ' reset pg. break index

Application.ScreenUpdating = False

With Sht
    .Activate
    LastRow = FindLastRow(Sht)
    
    With .PageSetup
        .PrintArea = "$A$1:I" amp; LastRow
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
'        .PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = UBound(PgBreakRowsArr)   1
    End With
    
    ActiveWindow.View = xlPageBreakPreview ' switch to Page Break view to set page breaks
'    Debug.Print .HPageBreaks.Count
    
    ' loop through array and create Page Breaks according to array's rows
    For i = 1 To UBound(PgBreakRowsArr) - 1
        Set .HPageBreaks(i).Location = Range("A" amp; PgBreakRowsArr(i))       
    Next i
    ' --- last one need to add it (not move existing one) ---
    .HPageBreaks.Add Before:=Range("A" amp; PgBreakRowsArr(i))
                                                 
     ActiveWindow.View = xlNormalView ' go back to normal view
End With

Application.ScreenUpdating = True

End Sub
  

.HPageBreaks это кошмар. Я много раз рвал на себе волосы из-за этого. Вот вам несколько волшебных вещей, которые не причиняют вреда и могут помочь:

1. Проблема .ResetAllPageBreaks перед установкой чего-либо

2. Переверните Application.PrintCommunication = False до и ... True после. Это может улучшить результат, а также ускорить операцию. Это зависит от вашего принтера и драйвера принтера.

3. Переместите activecell из затронутой области и восстановите ее (при необходимости) после настройки разрывов страницы, например

    somestring = Activecell.Address
   Cells(4000, 3000).Activate
   ....
   Range(somestring).Activate
     

Если количество страниц на фактическом листе и размер расположения, требуемого для разделения страницы, отличаются, возникает явление увеличения и уменьшения. Если размер массива меньше фактического объема страницы, он уменьшится, поэтому было бы лучше удалить эту фразу.

 .FitToPagesTall = UBound(PgBreakRowsArr)   1
  

Значение параметра FitToPagesTall равно 5 в 16-страничном документе

Значение параметра FitToPagesTall равно 8

Значение параметра FitToPagesTall равно 10

Значение параметра FitToPagesTall равно 13

Если значение FitToPagesTall равно 16, удалите этот код