每頁僅打印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個細胞所需要的行第一頁。