Amalgamate A6尺寸頁在A4尺寸頁面上打印

場景：我的Excel文件有大約120張。我已經使用了每頁1頁。頁面的大小是A6。所以，我在整個工作簿上有120個A6頁面。Amalgamate A6尺寸頁在A4尺寸頁面上打印

我需要做什麼：我想製作一張單頁的A6頁面大小，其中包含整個工作簿中的所有A6頁面。然後我需要在A4尺寸的頁面上進行打印（每頁4 x A6頁）。

問題：以下代碼將所有工作表收集到一張工作表中。但問題是它會將A6頁面收集到「Letter」大小頁面。所以，當我點擊打印預覽時，它會在一張A4紙上顯示20個小頁面。當我選擇A4時，它應該每張僅顯示4頁（因爲A4 = 4×A6）。但爲什麼這是顯示20頁。它在A4上打印非常小的20頁而不是4頁。這不是打印機設置或頁面設置問題，而是它自己生成這樣一張表的代碼。

Private Sub CommandButton1_Click() 
Dim wshTemp As Worksheet, wsh As Worksheet 
Dim rngArr() As Range, c As Range 
Dim i As Integer 
Dim j As Integer 

ReDim rngArr(1 To 1) 
For Each wsh In ActiveWorkbook.Worksheets 
    i = i + 1 
    If i > 1 Then ' resize array 
     ReDim Preserve rngArr(1 To i) 
    End If 

    On Error Resume Next 
    Set c = wsh.Cells.SpecialCells(xlCellTypeLastCell) 
    If Err = 0 Then 
     On Error GoTo 0 

     'Prevent empty rows 
     Do While Application.CountA(c.EntireRow) = 0 _ 
      And c.EntireRow.Row > 1 
      Set c = c.Offset(-1, 0) 
     Loop 

     Set rngArr(i) = wsh.Range(wsh.Range("A1"), c) 
    End If 
Next wsh 

'Add temp.Worksheet 
Set wshTemp = Sheets.Add(after:=Worksheets(Worksheets.Count)) 

On Error Resume Next 
With wshTemp 
    For i = 1 To UBound(rngArr) 
     If i = 1 Then 
      Set c = .Range("A1") 
     Else 
      Set c = _ 
       ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) 
      Set c = c.Offset(2, 0).End(xlToLeft) 'Skip one row 
     End If 

     'Copy-paste range (prevent empty range) 
     If Application.CountA(rngArr(i)) > 0 Then 
      rngArr(i).Copy c 
     End If 
    Next i 
End With 
On Error GoTo 0 

Application.CutCopyMode = False ' prevent marquies 

With ActiveSheet.PageSetup  'Fit to 1 page 
    .Zoom = False 
    .FitToPagesWide = 1 
    .FitToPagesTall = 1 

End With 

'Preview New Sheet 
ActiveWindow.SelectedSheets.PrintPreview 

'Print Desired Number of Copies 
i = InputBox("Print how many copies?", "ExcelTips", 1) 
If IsNumeric(i) Then 
    If i > 0 Then 
     ActiveSheet.PrintOut Copies:=i 
    End If 
End If 

'Delete temp.Worksheet? 
If MsgBox("Delete the temporary worksheet?", _ 
    vbYesNo, "ExcelTips") = vbYes Then 
    Application.DisplayAlerts = False 
    wshTemp.Delete 
    Application.DisplayAlerts = True 
End If 
End Sub

來源

2016-02-18 Pretty_Girl

隨着ActiveSheet.PageSetup「調整到1頁 .Zoom =假 .FitToPagesWide = 1 .FitToPagesTall = 1我認爲，這是你的問題。嘗試改變爲不同的值。如果你會看到變化，你需要想辦法將worksheet.count除以4，並均勻分割或使Wide = 1，tall = count/4 – Claudius

@Claudius它不會做任何事情 –

我的意思是它會看起來像同樣，把打印預覽看起來有什麼不同？這部分代碼告訴excel適合單個打印頁面上的整個工作表 – Claudius

變化

With ActiveSheet.PageSetup  'Fit to 1 page 
    .Zoom = False 
    .FitToPagesWide = 1 
    .FitToPagesTall = 1 

End With

到

With ActiveSheet.PageSetup  'Fit to 1 page 
    .Zoom = 100 
    .FitToPagesWide = 1 
    .FitToPagesTall = 1 

End With

來源

2016-02-18 13:44:56 Claudius

有了這個改變，現在它在打印預覽中顯示了2頁。數據和文本不在宏創建的新工作表的頁面區域之外。該代碼正在複製和粘貼數據到一個字母大小的頁面。這是問題。該代碼中是否設置了任何頁面大小？或者像'.PageSize = A6'之類的代碼。 –

這裏是一個列表https://msdn.microsoft.com/zh-cn/library/office/ff834612.aspx – Claudius

Amalgamate A6尺寸頁在A4尺寸頁面上打印

回答

相關問題