PDA

View Full Version : export and print multipe specific sheets as pdf



maghari
05-18-2020, 12:47 PM
hi,

this my code really works i would tweak to make it specific sheets save as pdf and print out for instance i have 10 sheets then i would save as pdf only (sheet1,sheet5,sheet8) and print out them i try with this line but it doesn't work i have no experience for vba

ThisWorkbook.Worksheets(Array("1", "2", "3")).PrintOut

this is my code

Sub pdfcopy()
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = False
Application.EnableEvents = False

Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lOver As Long
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strPath = ThisWorkbook.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"'
For i = 1 To Sheets.Count
If i <> "" Then
strName = i & "-salim-" & ActiveSheet.Range("b3").Value
strFile = strName & ".pdf"
strPathFile = strPath & strFile
If bFileExists(strPathFile) Then
lOver = MsgBox("the file is existed do you replaced it ?", _
vbQuestion + vbYesNo, "file is existed ")
If lOver <> vbYes Then
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="choose place of save ")
If myFile <> "False" Then
strPathFile = myFile
Else GoTo exitHandler
End If
End If
End If
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If'
Next i
MsgBox "folder is created: " & vbCrLf & strPathFile
errHandler: Resume exitHandler
exitHandler:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub'=============================
Function bFileExists(rsFullPath As String) As Boolean
bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function

jolivanes
05-18-2020, 10:10 PM
Maybe try this after changing what needs to be changed.

Sub Print_Certain_Sheets_To_PDF()
Dim shArr, PDF As String, a As String
a = ActiveSheet.Name
PDF = ThisWorkbook.Path & "\" & "Test.PDF" '<----- Change Name To SaveAs as required
shArr = Array("Sheet1", "Sheet5", "Sheet8") '<----- Change Sheet Names as required
Application.ScreenUpdating = False
Sheets(shArr).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF
Sheets(a).Select
Application.ScreenUpdating = True
End Sub



Sub Each_Sheet_Individually()
Dim shArr, i As Long
shArr = Array("Sheet1", "Sheet5", "Sheet8") '<---- Change as required
Application.ScreenUpdating = False
For i = LBound(shArr) To UBound(shArr)
With Sheets(shArr(i))
.PageSetup.PrintArea = .UsedRange.Address
.PrintOut , , , , , True, , ThisWorkbook.Path & "\Temp File " & .Index & ".PDF" '<---- Change file name as required
End With
Next i
Application.ScreenUpdating = True
End Sub

maghari
05-19-2020, 12:51 AM
thanks jolivanes but , i would save sheets as pdf in multple pdf not threes sheets in single file i want save each sheet in single file :(

jolivanes
05-19-2020, 11:52 AM
Did you not read/try the 2nd macro.
Did you mention in your first post that that is what you wanted?

maghari
05-19-2020, 01:21 PM
i really read i'm talking about save as pdf each sheet to each pdf this is macro 1 not 2 ,the macro2 is print?

jolivanes
05-19-2020, 09:44 PM
Have you run the 2nd macro?

maghari
05-20-2020, 01:29 AM
yes i run it and show me only massage print out :yes

jolivanes
05-20-2020, 09:08 AM
Yes, if you go to the folder where your excel file is stored/saved that you are printing/saving to pdf, do you find any pdf files named "Temp File" with a number following that?
Did you change anything in the code. Maybe show us your changed code here.
Ran this code several times and it works like a charm here.
Let us know if you find these files in that folder.
If not, I'll have another macro for you.

maghari
05-20-2020, 12:28 PM
actually i check the folder "temp" there is no existed my file works from desktop it supposes showing folder on desktop right ?
it shows two file as pdf on desktop not folder and when i open them it gives me error about pdf if you sure about your macro i attach my file and test it and tell me about it maybe the problem from my pc

jolivanes
05-20-2020, 09:23 PM
Re: actually i check the folder "temp"
Not folder. The Folder where the pdf files are saved to is the same folder where your excel file with the code in it is stored.
The files are named "Temp File " with the Index Number of the sheet saved as pdf added to it.
If the index number of the sheet that is saved as a pdf file is 25 then the pdf file will be named "Temp File 25.PDF"
I copied the file you attached onto my desktop, opened it and ran the "Sub Each_Sheet_Individually()" macro and the three pdf files were on the desktop. See picture.
BTW, you have this in your code

shArr = Array("Sheet1", "sheet2", "sheet3")
In your workbook you don't have "sheet2" or "sheet3".
In your workbook you have "Sheet1", "Sheet2" and "Sheet3". All with a capital "S".
If all else fails, try this code

Sub Each_Sheet_Individually_Version_2()
Dim shArr, PDF As String, i As Long
shArr = Array("Sheet1", "Sheet2", "Sheet3") '<----- Change Sheet Names as required
For i = LBound(shArr) To UBound(shArr)
With Sheets(shArr(i))
.PageSetup.PrintArea = Sheets(shArr(i)).UsedRange.Address
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
CreateObject("WScript.Shell").Specialfolders("Desktop") & "\" & .Name & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End With
Next i
End Sub
I tested this code with your workbook and it saved the three sheets as pdf files on the desktop.

maghari
05-21-2020, 02:38 AM
hi, jolivanes i agree with you about picture on desktop also code works me to put on three files on desktop but the problem when i try opening which file it gives me error as attached image , did you open any file what existed on desktop ? by the way your a new code works perfectly but if you don't mind , could
you make clear why after saved file on desktop it gives me error when i try opening it ? do you have any explanation ? :think:26713

jolivanes
05-21-2020, 08:51 AM
No, I don't have an explanation for that and yes, I opened all three files. No problem with that.
BTW, can't open your attachment.

maghari
05-21-2020, 09:05 AM
here it is
26721

jolivanes
05-21-2020, 12:17 PM
Just out of curiosity, if you go to Control Panel\Hardware and Sound\Devices and Printers and set the "Microsoft Print to PDF" as your default printer and try that code again, does that make a difference?

You can also try changing this line

.PrintOut , , , , , True, , ThisWorkbook.Path & "\Temp File " & .Index & ".PDF" '<---- Change file name as required
with this

.ExportAsFixedFormat 0, ThisWorkbook.Path & "\Temp File " & .Index & ".PDF"
and see if that makes a difference

If the first suggestion, changing printers, works it is probably because I have the "Microsoft Print to PDF" set as my default printer.

maghari
05-21-2020, 01:21 PM
actually about your first suggestion "Microsoft Print to PDF" this isn't existed in the printers and you second suggestion about change line code it success i would thank you for every thing i appreciate your efforts and time you give me more than what i need every thing is ok
:clap::clap::clap::clap::clap::clap::clap:

jolivanes
05-21-2020, 01:59 PM
You should install it.
https://answers.microsoft.com/en-us/windows/forum/windows_10-hardware/how-to-add-or-reinstall-the-microsoft-pdf-printer/70377c34-e50a-42be-b9f3-92345d6e25df

Good Luck