Excel 2010 Using VBA to print sheet(s) - vba

I've been using the following code to print a sheet (with VBA) in a workbook. We are currently using Excel 2010. I've used this code for a long time and now I have a user who says the printed copy comes out extremely small and light.
The user says she has to enlarge the print to a #12 and bold all the info on the sheet so that the information is readable. Otherwise she claims it is impossible to read because it is so small.
Is there any properties I can add to this code or make changes to the existing properties to ensure the copy is more readable?
Would it be better to print to a PDF file?
Thanks for your help and suggestions.........
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
.PrintArea = ""
.CenterHeader = "&A "
.RightFooter = "&""Arial,Regular""&8&P of &N"
.LeftMargin = Application.InchesToPoints(0.35)
.RightMargin = Application.InchesToPoints(0.35)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintGridlines = True
.CenterHorizontally = True
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Related

Export to PDF script only exports the last worksheet

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

Excel vba plot showing worksheet name + page number/adding title page in plot

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.

Regularly printing to Adobe PDF from Excel, script to force PDFs to be saved to correct path

I am working on a series of XLS files in Excel. When I am done with them, I need to print them to PDF so that they can be transmitted to a party outside my firm.
I recorded a fairly basic macro to allow me to print these files with the same setting every time. Unfortunately, it is not doing everything I need it to do.
Basically, I want Adobe to ask me where the file should be saved when it's being printed. That is not taking place right now with my script. If I manually print and select the settings "Ask to replace existing PDF file" from the Printer Properties window in Excel, it always asks me where the file should be saved. My script is not catching this, however, and I'm not sure what I need to add.
I have a lot of files to go through (and this is a task that will recur) so the sooner I get this nailed down the better.
Is this something that I can address with my Excel macro, and if so, can anyone point me in the right direction?
Sub PrintToAdobeRedactions()
'
' PrintToAdobeRedactions Macro
' Print redacted worksheets to Adobe with correct settings every time.
'
' Keyboard Shortcut: Ctrl+e
'
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "[Tab]"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "Page [Page]"
.RightFooter = ""
.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 = xlPrintSheetEnd
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlOverThenDown
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
.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
ActiveWorkbook.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub
To SaveAs a PDF:
Sub SaveAsPDF()
Dim SaveName as String
SaveName = InputBox("Save As File Name?")
ThisWorkbook.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Application.ActiveWorkbook.Path & Application.PathSeparator & SaveName & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub

Change in Print Settings only works on first iteration of For loop

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

Macro changing "page setup" not working

I have a simple macro that was recorded to format some cells and also setup some some page formatting (margins footer header ect..) The macro runs without errors and it formats the cells just fine but does not save/change any of the page setup options. After i run it if i check the page setup everything is still at default. Below is the page setup portion. I have tried this on multiple files/workbooks it does not seem to save the changes no matter what. Any ideas?
Thanks
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&F"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "Page &P of &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.25)
.FooterMargin = Application.InchesToPoints(0.25)
.PrintGridlines = True
.Orientation = xlLandscape
.FirstPageNumber = xlAutomatic
.FitToPagesWide = 1
End With
I was having the same problem and later after some research, found the solution below.
"You cannot use page setup properties in Excel if no printers were installed"
http://support.microsoft.com/kb/291298
I hope this helps. Thanks.