Print specific sheets seperately to printer and PDF

vlacombe

New Member
Joined
Oct 4, 2019
Messages
31
Is this doable and could someone suggest a script?

(Script would need to be seperate)

1. Print sheets seperately without prompt to the default printer: only i
f the sheet contains the text: "PrixMax" "6po" "Quote" (Then print them, else ignore)

2. Create a PDF per sheet
(If sheet contains the text: "PrixMax" "6po" "Quote" Then create a PDF for each, else ignore) without prompt (like using the microsoft print to PDF "printer" even though it's not the default printer, and send the file(s) and to a specific path written in the script... like a folder on the desktop. Script can use the sheet name as file name and I would want it to overwrite the PDF file if one is existant.


 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Try this

Code:
Sub Print_sheets()
  Dim sh As Worksheet, i As Long, shs As Variant
  Application.ScreenUpdating = False
  shs = Array("PrixMax", "6po", "Quote")
  For Each sh In Sheets
    For i = 0 To UBound(shs)
      If LCase(sh.Name) Like "*" & LCase(shs(i)) & "*" Then
        sh.PrintOut Copies:=1
        sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & sh.Name & ".pdf", OpenAfterPublish:=False
        Exit For
      End If
    Next
  Next
End Sub
 
Upvote 0
Dante! You again :)

It works like a charm. I needed 2 seperate script but I manage to seperate both based on your example :D
What if I wanted to save each sheets as a different excel file with the exact same critera? (File name can be exactly like the pdf files but with .xls extension)

It should look exactly like your suggested script but I need to replace these 2 highlighted lines by??

Sub Print_sheets()
Dim sh As Worksheet, i As Long, shs As Variant
Application.ScreenUpdating = False
shs = Array("PrixMax", "6po", "Quote")
For Each sh In Sheets
For i = 0 To UBound(shs)
If LCase(sh.Name) Like "*" & LCase(shs(i)) & "*" Then

sh.PrintOut Copies:=1
sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "" & sh.Name & ".pdf", OpenAfterPublish:=False

Exit For
End If
Next
Next
End Sub
 
Upvote 0
Try this

Code:
sh.copy
    ActiveWorkbook.SaveAs Filename:= [COLOR=#333333]ThisWorkbook.Path & "\" & sh.Name & ".[/COLOR]xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.close false

Note: The above is for versions of Excel 2007 or higher
 
Upvote 0
Hi again Dante,

Some of the cells in the sheets I want to save refers to another sheet cell's value
Would it be possible to save the sheet without considering the formula but take the formula output as straigh up value?

Also when using your script, I'm always getting a pop up for compatibility checker. It warns me that some function might not be compatible with earlier versions of excel...
I'm aware of that but I would prefer it it doesn't ask me... I'm using the latest office 365

After that It pops another screen about excel version...

Here's the 2 screens:
https://i.imgur.com/OkOnXZj.png
https://i.imgur.com/ReINW5R.png

Can these 2 be avoided?
 
Upvote 0
Do you want the file as xls or xlsx?

After this line
Code:
[COLOR=#333333]Application.ScreenUpdating = False[/COLOR]

Add this line:
Code:
[COLOR=#333333]Application.DisplayAlerts = False[/COLOR]
 
Upvote 0
Dante, my mistake

I do not need an older extension version... only the latest... I just assumed excel are xls too quickly
My files are indeed .xlsx and it is what I want
 
Upvote 0
Then try this

Code:
Sub Print_sheets()
  Dim sh As Worksheet, i As Long, shs As Variant
  Application.ScreenUpdating = False
[COLOR=#0000ff]  Application.DisplayAlerts = False[/COLOR]
  shs = Array("PrixMax", "6po", "Quote")
  For Each sh In Sheets
    For i = 0 To UBound(shs)
      If LCase(sh.Name) Like "*" & LCase(shs(i)) & "*" Then
[COLOR=#0000ff]         sh.copy[/COLOR]
[COLOR=#0000ff]         ActiveWorkbook.SaveAs Filename:= ThisWorkbook.Path & "\" & sh.Name & ".xlsx"        [/COLOR]
[COLOR=#0000ff]         ActiveWorkbook.close false[/COLOR]

        Exit For
      End If
    Next
  Next
End Sub
 
Upvote 0
Hello Dante, thanks a lot for your support

The script works flawlessly. But only 1 issue remain as I mentionned above
many cells in the Excel file saved seperately refers to a value of another sheet from the previous notebook

for instance:
='[CALCULETTE-TEMPLATESEMIFINAL.xlsm]Prix-6po-2019'!B7

Now the issue I have is if I move my seperate save (saved by the script) elsewhere on my drive or the network, it might not be able to reach the path of "CALCULETTE-TEMPLATESEMIFINAL.xlsm"

Is there a work around in the script to save the excel file without taking into account any link to external sheets or workbook but save only the return value of the formula and not the formula refering to another sheets
All the concerned cells are from I21 to I45, although few cells in between aren't referring to any formula or return value from other sheets, but are just plain text or empty with borders and styles. Would you need to know only the specific concerned cells?

Can we do something about this?

Thank you
 
Upvote 0
Try this

Code:
Sub Print_sheets()
  Dim sh As Worksheet, i As Long, shs As Variant, w2 As Workbook, sh2 As Worksheet
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  shs = Array("PrixMax", "6po", "Quote")
  For Each sh In Sheets
    For i = 0 To UBound(shs)
      If LCase(sh.Name) Like "*" & LCase(shs(i)) & "*" Then
        sh.Copy
        Set w2 = ActiveWorkbook
        Set sh2 = w2.Sheets(1)
        sh2.Cells.Copy
        sh2.Range("A1").PasteSpecial xlPasteValues
        w2.SaveAs Filename:=ThisWorkbook.Path & "" & sh.Name & ".xlsx"
        w2.Close False
        Exit For
      End If
    Next
  Next
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,556
Messages
6,114,284
Members
448,562
Latest member
Flashbond

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top