excel - Excel VBA Page-Setup - 添加 HPage-Breaks 后适合宽度的页面失去了它的价值

Question

我正在尝试设置一个大约 3000 行的 Excel 工作表，以便很好地打印到 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" & 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

score 1 · Accepted Answer

.HPageBreaks是一场噩梦。我在上面拉了很多次头发。这里有一些神奇的东西，它们不会造成伤害并且可能会有所帮助：

.ResetAllPageBreaks在设置任何东西之前发出问题
Application.PrintCommunication = False前后翻 ... True。它可以提高结果，也可以加快操作。这取决于您的打印机和打印机驱动程序。
将活动单元格移出受影响的区域并在设置分页符后将其恢复（如有必要），例如
```
somestring = Activecell.Address
Cells(4000, 3000).Activate
....
Range(somestring).Activate
```

score 0 · Accepted Answer

如果实际纸张上的页数和分页所需的排列尺寸不同，就会出现放大缩小的现象。如果数组的大小小于实际的页数，它会缩小，所以最好删除这个短语。

.FitToPagesTall = UBound(PgBreakRowsArr) + 1

案例 FitToPagesTall 在 16 页文档中为 5

案例 FitToPagesTall 为 8

案例 FitToPagesTall 为 10

案例 FitToPagesTall 为 13

Case FitToPagesTall 为 16 或删除该代码

excel - Excel VBA Page-Setup - 添加 HPage-Breaks 后适合宽度的页面失去了它的价值

2 回答 2

Related

Reference