每页仅打印50行

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

第二个问题第一：.PrintTitleRows = "$3:$3"

（与你的头的开始和结束行号替换3的）对于你的第一个：你可以通过添加这一行你内的ActiveSheet.PageSetup块重复对未来的网页标题问题：检查清除后是否仍然出现错误

.FitToPagesWide = 1 
.FitToPagesTall = 1 

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

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

所以我不能让布拉德斯建议的工作，但与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") 

这是插入一个Hpagebreak上述单元51只允许50个细胞所需要的行第一页。