Excel VBA Page-Setup - Page fit to width looses it's value after adding HPage-Breaks

Question

I am trying to set-up an Excel sheet with about 3000 rows, to print nicely to a PDF file. I am trying to set-up the page to fit 1 page width, and I want to modify the Horizontal Page breaks according to row numbers stored in an array PgBreakRowsArr.

After I run the attached sub-routine, the page breaks are set-up nicely, but the printing width has shrunk from ~85% to ~45%, and printing at about 50% of the page size.

Any ideas ?

Code

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" & 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" & PgBreakRowsArr(i))       
    Next i
    ' --- last one need to add it (not move existing one) ---
    .HPageBreaks.Add Before:=Range("A" & PgBreakRowsArr(i))
                                                 
     ActiveWindow.View = xlNormalView ' go back to normal view
End With

Application.ScreenUpdating = True

End Sub

Answer 1

.HPageBreaks is a nightmare. I pulled my hair out many times on it. Here you are a few magical things that make no harm and may help:

1. Issue .ResetAllPageBreaks before setting anything

2. Turn Application.PrintCommunication = False before and ... True after. It can improve the result, and also can speed up the operation. It depends on your printer and the printer driver.

3. Move the activecell out of the affected area and restore it (if necessary) after setting page breaks, like

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

Answer 2

If the amount of pages on the actual sheet and the size of the arrangement required for page division are different, the phenomenon of enlargement and reduction occurs. If the size of the array is smaller than the actual page amount, it will shrink, so it would be better to delete this phrase.

.FitToPagesTall = UBound(PgBreakRowsArr) + 1

Case FitToPagesTall is 5 in a 16-page document

Case FitToPagesTall is 8

Case FitToPagesTall is 10

Case FitToPagesTall is 13

Case FitToPagesTall is 16 or remove the that code