PDA

View Full Version : [SOLVED] save certain sheets as a pdf from a closed wb



satyen
03-27-2013, 09:05 AM
Could some please help. I am looking to save certain sheets from a closed workbook as pdf files in a destination folder. This macro will be run daily. I have had a go to start this off with one sheet.
Please could someone help.


Sub Test()
Dim Sh As Worksheet
Dim bled As Workbook

'Where the sheets reside.
Cops = "C:\Input\TheBook.xls"



For Each Sh In bled

Sheets(SheetCar).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Output\SheetCar.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

Next
End Sub

patel
03-27-2013, 01:18 PM
Sub exportToPdf()
Cops = "C:\Input\TheBook.xls"
Workbooks.Open Filename:=Cops
strFilePath = "C:\Users\Output\"
Application.ScreenUpdating = False
For Each Sh In Sheets
strPdfName = Sh.Name & ".pdf"
Sh.Copy
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFilePath & strPdfName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
ActiveWorkbook.Close (False)
Next
Application.ScreenUpdating = True
End Sub

satyen
03-28-2013, 07:02 AM
Thanks Patel :) I would like to select certain sheets not all to be saved as PDF's. How could I change the code to say only save Test1, Test5, Test6, Test7 as pdf's?

satyen
03-28-2013, 09:05 AM
I have managed to figure the code for this, and will post soon to share. Now I just have to figure out how to prompt the user for a location as it will change on a daily basis.

Kenneth Hobs
03-28-2013, 11:08 AM
Private Sub SaveWB()

Dim UserDirectory As String

UserDirectory = Get_Folder("Enter directory path where ReadMe is to be placed:")
If UserDirectory = "" Then Exit Sub
UserDirectory = UserDirectory & "/"

ActiveWorkbook.SaveAs FileName:=UserDirectory & "test.xls"

End Sub

Private Function Get_Folder(Optional HeaderMsg As String) As String
With Application.FileDialog(msoFileDialogFolderPicker)
.initialFilename = Application.DefaultFilePath
.Title = HeaderMsg
If .show = -1 Then
Get_Folder = .SelectedItems(1)
Else
Get_Folder = ""
End If
End With
End Function