EXCEL 将多个 Sheet 工作表打印在一个页面

EXCEL 工作簿中可以包含各种数据。如果有一个包含多个 Sheet 工作表的工作簿,每个工作表只包含少量数据,那么是否有方法可以在同一张纸上打印多个工作表呢?

EXCEL 在单页上打印多个 Sheet 工作表
EXCEL 在单页上打印多个 Sheet 工作表

许多人为了合并打印的内容,会创建了一个“打印工作表”,将工作簿中所有工作表上要打印的区域复制在一起。这样就可以将所有工作表中的内容打印在一起了,但是这种方法实在是有点麻烦。

要将多个工作表合并为一个工作表进行打印,可以通过宏来自动化实现。以下宏将在工作簿末尾创建一个新工作表,并将所有其他工作表中的内容复制到其中。

Sub PrintOnePage()
    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

组合的工作表放在一起后,宏使用打印预览显示工作表。当关闭打印预览时,它会询问要打印多少份工作表。如果输入一个大于零的数字,则会打印对应份数。最后,宏会在完成之前删除组合工作表。

作者:牛奇网,本站文章均为辛苦原创,在此严正声明,本站内容严禁采集转载,面斥不雅请好自为之,本文网址:https://www.niuqi360.com/excel/printing-multiple-worksheets-on-a-single-page/

(1)
牛奇网牛奇网
上一篇 2022年5月25日 上午9:51
下一篇 2022年5月26日 上午10:41

相关推荐

发表回复

登录后才能评论
2024年独立站建站最佳服务器主机Cloudway黑五大促前4个月40%OFF,立即获取优惠