场景：我的 Excel 文件大约有 120 张。我每张纸用了 1 页。页面大小为 A6。所以，我在整个工作簿上有 120 页 A6。
我需要做的事情：我想制作一张 A6 页面大小的单张纸，其中包含整个工作簿中的所有 A6 纸。然后我需要在 A4 尺寸的页面上打印（每张 4 x A6 页）。
问题：以下代码将所有工作表收集到一张工作表中。但问题是它将 A6 页面收集到“信”大小的页面。所以，当我点击打印预览时，它会在一张 A4 纸上显示 20 个小页面。当我选择 A4 时，每张纸应该只显示 4 页（因为，A4 = 4 X 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