I have a report that I am trying to print with a VBA script. I need to print the report on one page (portrait) and have it centered. I have the formatting down pat, but the range is causing me issues. I need to set the print range to adjust to the number of values in the named range. Right now, it will print the named range, but it will not resize or print the expanded or contracted range if there have been entries added or removed.
Sub PrintFailureReport()
Sheets("Failure Report").Activate
Range("FailReportPrintArea").Select
ActiveSheet.PageSetup.PrintArea = Selection.Range("FailReportPrintArea").Address
Application.PrintCommunication = True
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
' .HeaderMargin = Application.InchesToPoints(0.3)
' .FooterMargin = Application.InchesToPoints(0.3)
.PrintGridlines = False
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.BlackAndWhite = True
End With
Range("FailReportPrintArea").PrintOut
End Sub
I think it has to do with Application.PrintCommunication = False not being added before you set the address
Sub PrintFailureReport()
Sheets("Failure Report").Activate
Range("FailReportPrintArea").Select
Application.PrintCommunication = False
ActiveSheet.PageSetup.PrintArea = Selection.Range("FailReportPrintArea").Address
Application.PrintCommunication = True
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.25)
.BottomMargin = Application.InchesToPoints(0.25)
' .HeaderMargin = Application.InchesToPoints(0.3)
' .FooterMargin = Application.InchesToPoints(0.3)
.PrintGridlines = False
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.BlackAndWhite = True
End With
Range("FailReportPrintArea").PrintOut
End Sub
Related
I have an Excel VBA script that exports the contents of a worksheet to PDF. It worked fine with a single worksheet, but now I've been asked to have it include a second worksheet. However, using the script below now only includes the second worksheet and not the first. Can anyone advise why the first worksheet of the pair is not included?
Dim sheetsToPrint as Variant(1)
sheetsToPrint(0) = FirstWorksheet.Name
sheetsToPrint(1) = SecondWorksheet.Name
FirstWorksheet.PageSetup.PrintArea = Union(FirstWorksheet.Range("B2:I10"), FirstWorksheet.UsedRange).Address
With FirstWorksheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = -4
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
End With
SecondWorksheet.PageSetup.PrintArea = Union(secondPage.Range("B2:I10"), secondPage.UsedRange).Address
With SecondWorksheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = -4
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
End With
saveAndClose sheetsToPrint
The saveAndClose function is defined like this:
Private Sub saveAndClose(ByRef sheetsToPrint() As Variant)
Sheets(sheetsToPrint).Select
Dim primarySheetName As String
primarySheetName = CStr(sheetsToPrint(0))
Application.DisplayAlerts = False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=outputDirectoryPath & ":" & primarySheetName & ".pdf"
Sheets(sheetsToPrint).Delete
Application.DisplayAlerts = True
End Sub
This is part of a batch process, so I haven't copied all of my code, but this is the part that currently exports a PDF containing only the information from sheetsToPrint(1) but not sheetsToPrint(0). I've been banging my head on this all afternoon since as far as I can see, it's the same as every example on the internet of how to export multiple sheets to PDF.
Can anyone spot where I've gone wrong?
Can you set it up like this:
Dim sheetsToPrint As Sheets
Set sheetsToPrint = Sheets(Array("Blad1", "Blad2", "Blad3"))
And then use sheetsToPrint.select in the saveandclose sub
The folowing code is used to auto define the header/footer while plotting an excel worksheet to pdf.
Only thing that doesn't seem to work is the centerfooter function, it's supposed to give "active sheet name - defined date in dd-mm-yyyy format (value of cell Sheets("instellingen").Cells(22, 2) ), this results only in returning the date in format "mm-dd-yyyy" in the centerfooter, ignoring and not returning the activesheet name part.
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "Company name"
.RightHeader = ""
.LeftFooter = Sheets("instellingen").Cells(20, 2).Value
.CenterFooter = Activesheet.name & " - " & Sheets("instellingen").Cells(22, 2).Value
.RightFooter = "Pagina &P van de &N"
Thanks :)
Edit. (full macro)
Sub PlotPDF()
'
' PlotPDF Macro
'
' Sneltoets: Ctrl+Shift+P
'
Application.PrintCommunication = False
Application.Dialogs(xlDialogPrinterSetup).Show
With ActiveSheet.PageSetup
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.PageSetup.PrintArea = "$A:$N"
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "Company name"
.RightHeader = ""
.LeftFooter = Sheets("instellingen").Cells(20, 2).Value
.CenterFooter = ActiveSheet.Name & " - " & Format(Sheets("instellingen").Cells(22, 2).Value, "dd-MM-yyyy")
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Sub
Use the Format() function to format the date in .Cell(22, 2)
.CenterFooter = ActiveSheet.Name & " - " & Format(Sheets("instellingen").Cells(22, 2).Value, "dd-MM-yyyy")
I made the following script to automatic plot the active worksheet to a certain layout, in the right footer I would like to show the name of the active worksheet followed by the page number, 'edit: found the 'Activesheet.Name' formula, but still don't know how to add the page number (layout of page number: actual page numer/total amount of pages)
Example of a wanted right footer:
PartA - 1/12
Is it btw also possible to include a front page with just the name of the current worksheet, displayed in a big font in the center? Or is it needed to design the excel worksheet that way that the first page just contains one active cell with the title in the center?
Application.PrintCommunication = False
Application.Dialogs(xlDialogPrinterSetup).Show
With ActiveSheet.PageSetup
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.PageSetup.PrintArea = "$A:$N"
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "PROJECT X"
.RightHeader = ""
.LeftFooter = Sheets("instellingen").Cells(20, 2).Value
.CenterFooter = Sheets("instellingen").Cells(22, 2).Value
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 0
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Thanks :)
When you are looking for a syntax, recording a macro while you do the manual steps can be very helpful.
I used Excel's built-in Page 1 of ? custom filter to get the syntax you are after. Manually, I went to Page Layout > Page Setup > Header / Footer > Footer > Page 1 of ?
.RightFooter = ActiveSheet.Name & " - " & "Page &P of &N"
You can really force a page number, since you don't know how many pages there are. So it's the same as setting it in regular Excel.
Try this Page &[Page] of &[Pages]
Regular format taken from https://support.office.com/en-us/article/Add-or-remove-page-numbers-57ebb99e-0cfc-408b-864a-c805b5040ae7
Side note, isn't using .PageSetup slow? I can't remember if they fixed it or not? There is a trick with using the print setup from the Excel4 Macros that was much faster.
I've been working on a print macro that I think is probably simple. I've tried recording a macro and have been researching for a few hours looking at other peoples code. What I would like is for the macro to:
1) select all cells in the active worksheet
2) set print scale to fit all columns to one page
3) print landscape mode
4) Open print preview (if possible)
5) If #4 is not possible then execute print job.
When I run my current code my excel worksheet gets split into tons of page (checker board style) and then I get an error code. Thanks for reading.
This is my current code:
Sub PrintNOPAsheet()'
' PrintNOPAsheet Macro
Cells.Select
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$346"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Selection.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub
'
Here's what I usually use, then I made it to match your question. Within the With you can add as many of the properties you have from the recorded macro to suit your code.
Sub printIt()
Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
Dim rng as Range
Dim printRange as String
Set rng = ws.Range("A1:J11")
''''For Dynamic Ranges'''''
With ws
Set rng = .Range(.Range("A1"),.Range("J11").End(xlDown))
End With
''''Range from User Highlighted Cells''''
Set rng = Selection
''''This method is not the best way''''
printRange = ws.Name & "!" & rng.Address
With ws.PageSetup
.PrintArea = printRange
.Zoom = False
.FitToPagesWide = 1 'Question 2
.Orientation = xlLandscape 'Question 3
End With
ws.PrintOut preview:=True 'Question 4
End Sub
The code below is the code I have to set not only the print area, but margins and that the sheet is to fit onto one page. This code is wrapped up into a for loop that has many other sections both before and after that work just fine (so its not the 'Next i' being in the wrong place). This code will only work on the first iteration and will not work for any other iteration (each iteration includes code to create a new sheet that works just fine).
Why is this only working once? How do I get it to work on all iterations?
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = Range(Cells(1, 1), Cells(53, 29)).Address
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.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)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With