Question

我有一个工作表，可以选择已编辑的所有单元格并打印它们。我已经将打印选项设置为适合1页，但是当我开始打印超过50行时，它变得很小。这是我目前的代码

Dim R As Integer
On Error GoTo 1

R = Range("A65536").End(xlUp).Row

Worksheets("ACM").Range("E1").Font.Color = vbBlack
ActiveSheet.Range(Cells(1, 1), Cells(R, 5)).Select

ActiveSheet.PageSetup.PrintArea = Selection.Address

With ActiveSheet.PageSetup
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.5)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.5)
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .Orientation = xlPortrait
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

我尝试添加 ActiveSheet.HPageBreaks.Add.Cell（“A51”）使它每页只打印50行，但这行错误。

所以问题：有没有办法让它这样我只打印50行1页？第二个问题是我可以在第二页打印标题吗？

Answer 1

第二个问题：您可以通过在With ActiveSheet.PageSetup块中添加此行来重复未来页面上的标题：.PrintTitleRows = "$3:$3"（将3替换为标题的开头和结尾行）

关于第一个问题：检查删除后是否仍然出现错误

.FitToPagesWide = 1
.FitToPagesTall = 1

从您的代码

- 这将消除逻辑冲突。或者尝试将语法调整为Set ActiveSheet.HPageBreaks(1).Location = Range("B64") - 注意.Location = Range而不是.Add.Cell（我刚录制了一个宏）。最后，检查分页符代码是否在其自己的行上，而不是With块内。希望这三个建议中的一个能够奏效。

Answer 2

试试这个。您需要将sht变量设置为工作表名称。只使用ActiveSheet

Dim sht As Worksheet
Set sht = ActiveSheet

'this view needs to be active if you are making changes
'to the page setup which will affect printing.
ActiveWindow.View = xlPageBreakPreview

Dim bottomRow As Long, numberOfPageBreaks As Integer, p As Integer
Dim bottomRange As Range

'or set this manually if you have data with gaps in it
bottomRow = sht.Cells(1, 1).End(xlDown).Row

'minus 1 for the header row. Adjsut accordingly
numberOfPageBreaks = CInt((bottomRow - 1) / 50)

'print the first row on everypage
sht.PageSetup.PrintTitleRows = "1:1"

'start with a blank slate
sht.ResetAllPageBreaks

For p = 1 To numberOfPageBreaks
    With sht
        '+1 for the header. + another 1 for 'before'
        Set bottomRange = .Cells((50 * p) + 1 + 1, 1)
        If bottomRange.Row <= bottomRow Then
            Set .HPageBreaks(p).Location = bottomRange 
        End If

    End With
Next p

Answer 3

所以我无法让Brads建议工作但是修补ExactaBox我仍然无法让你的工作。

因此，一遍又一遍地录制宏后，我找到了这个解决方案。

R = Range("A65536").End(xlUp).Row
ws.Range("E1").Font.Color = vbBlack
ActiveSheet.Range(Cells(1, 1), Cells(R, 5)).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Range("A51")
ws.PageSetup.PrintArea = Selection.Address
Application.PrintCommunication = False
With ws.PageSetup
    .PrintTitleRows = "1:1"
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.5)
    .BottomMargin = Application.InchesToPoints(0.5)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.5)
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .Orientation = xlPortrait
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .FitToPagesWide = 1
    .FitToPagesTall = 0
    .PrintErrors = xlPrintErrorsDisplayed
    .ScaleWithDocHeaderFooter = True
End With
    Application.PrintCommunication = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

需要注意的一点是改变 .FitToPagesTall = 0'这是1，现在是0

另外 .PrintTitleRows =“1：1”'这确实可以打印标题谢谢ExactaBox

最后

ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Range("A51")

这是在单元格51上方插入Hpagebreak所需的行，在第一页上只允许50个单元格。

每页仅打印50行

3 个答案: