Log In
Register
Home
August 25, 2017
Offline
I have four spreadsheets and would like to print all four on one page when sent to the printer. I did not want to link the pages because of the graphics.
Is it possible to print specific areas of each spreadsheets to one page directly to the printer?
That is each section of the spreadsheet would print in a specific area on the page. Would it require a macro?
Thanks
June 25, 2020
Offline
Hi,
there is a Camera tool that you can add to the Quick Access Toolbar (it's called "Camera") - to add, click the dropdown arrow at the end of the QAT and select "More Commands…", then change the "Choose commands from:" box to "All Commands"; find the Camera command in the large selection below and double-click it and click "OK" to close
when clicked it will take a snapshot of the currently selected area which can then be pasted (with your next click on any cell); for example to a new "printout" sheet
these images will update to reflect any changes to the original selection (including any graphics overlaying them, even partially so)
do this for each of your required selections and rearrange to your heart's content (beware, this can waste a lot of your time!)
hope this works for you,
jim
February 20, 2020
Offline
Hello,
another solution, using VBA put the following code in a userform module if you don't want a userform, it can be placed in the standard module, without this part Private Sub CommandButton1_Click() & disable this part: Unload Me
and the macro can be called by a control (command button or shape) on the excel sheet
you can select the area you want to print on each of the sheets as shown in this part of the code:
If sht.Name = "Sheet2" Then ' select sheet name (change the name)
Set arrInput(i) = sht.Range(sht.Range("A1"), ("K17"))
or if you don't have charts, images or shapes on the sheet or just want to print the cell data for the whole sheet
Set arrInput(i) = sht.Range(sht.Range("A1"), rng)
for those who want to print only the data for all sheets, disable the parts of the code to select area
I left the macro on print preview mode the print out is disabled, you have 2 options, activate only one of them
Option Explicit
Private Sub CommandButton1_Click()
Call Print_All_In_One_Page
End Sub
Public Sub Print_All_In_One_Page()
Dim shtPrint As Worksheet, sht As Worksheet
Dim arrInput() As Range, rng As Range
Dim i As Integer
On Error Resume Next
ReDim arrInput(1 To 1)
On Error GoTo 0
'' * if data is missing from any worksheet cells, they will be ignored
'For Each sht In Application.ThisWorkbook.Sheets ' to select Sheets & WorkSheets
For Each sht In Application.ThisWorkbook.Worksheets ' only to select WorkSheets
i = i + 1
If i > 1 Then
ReDim Preserve arrInput(1 To i)
End If
On Error Resume Next
Set rng = sht.Cells.SpecialCells(xlCellTypeLastCell)
If Err = 0 Then
On Error GoTo 0
Do While Application.CountA(rng.EntireRow) = 0 And rng.EntireRow.Row > 1
Set rng = rng.Offset(-1, 0)
Loop
If sht.Name = "Sheet2" Then ' select sheet name
Set arrInput(i) = sht.Range(sht.Range("A1"), ("K17")) ' select area - ex: if there are shapes or charts on the sheet and we also want
ElseIf sht.Name = "Sheet4" Then ' select sheet name
Set arrInput(i) = sht.Range(sht.Range("A1"), ("K17")) ' select area - ex: if there are shapes or charts on the sheet and we also want
'ElseIf ...
Else
Set arrInput(i) = sht.Range(sht.Range("A1"), rng) ' only data in cells (no shapes & charts even if they exist)
End If
End If
Next sht
Set shtPrint = Sheets.Add(after:=Worksheets(Worksheets.Count)) ' add new sheet at the end
On Error Resume Next
With shtPrint
For i = 1 To UBound(arrInput)
If i = 1 Then
Set rng = .Range("A1")
Else
Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
Set rng = rng.Offset(3, 0).End(xlToLeft) ' add rows between data sheets
End If
If Application.CountA(arrInput(i)) > 0 Then
arrInput(i).Copy rng
End If
Next i
End With
On Error GoTo 0
Application.CutCopyMode = False
With ActiveSheet.PageSetup ' in one page
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Unload Me ' in case the macro has been activated in a userform
ActiveWindow.SelectedSheets.PrintPreview ' print preview
''------------------------------------------------------------
''--- activate only one option - OPTION 1 - select number of copies
''* indicate the number of copies
'retry:
'i = InputBox("How many print copies do you want?", "Please confirm!", 1)
'If IsNumeric(i) Then
' If i = 0 Then MsgBox "The number of copies must be greater than 0!", vbCritical, "An error has occurred!": GoTo retry:
' If i > 0 and i < 10 Then
' ActiveSheet.PrintOut Copies:=i
' Else
' MsgBox "The number of copies must be less than 10!", vbCritical, "An error has occurred!": GoTo retry:
' End If
' Else
' MsgBox "The number of copies must be inserted only in number, not in letters or symbols!", vbCritical, "An error has occurred!": GoTo retry:
'End If
''------------------------------------------------------------
''------------------------------------------------------------
''--- activate only one option - OPTION 2 - only one copie
' ActiveSheet.PrintOut ' print out
''------------------------------------------------------------
Application.DisplayAlerts = False
shtPrint.Delete
Application.DisplayAlerts = True
If Not rng Is Nothing Then Set rng = Nothing
If Not shtPrint Is Nothing Then Set shtPrint = Nothing
End Sub
Miguel,
1 Guest(s)
