Save as PDF

[elynoy]

Hello. I have this code wich works fine for every sheet, I'd like to make it to save all sheets with one click only.

I need all the sheets in the workbook to be saved separately with the sheet name and the year given in a cell like the code shows. It works like a charm but I have to go on page by page and run the macro as it is.

Is it possible to make it loop the sheets and save them all with just one time click?

Here's the code I have:
Private Sub Save_As_PDF()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler


Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Worksheets("Alterações").Range("C17").Value _

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, "", "")
strName = Replace(strName, "", "")


'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected ( I tried to edit this part with another code but it just wont work or remoes the date option)
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

Best regards,
eLy

 

[John_w]

You need to loop through each worksheet. Change Set wsA = ActiveSheet to:

For Each wsA In wbA.Worksheets

and end the loop by adding

Next

above the exitHandler line.

Also, move the strPathFile and related lines and GetSaveAsFilename above the loop, otherwise it will prompt for the file for each sheet.

You could try adapting the code at https://www.mrexcel.com/forum/excel...ased-their-sheet-post5038663.html#post5038663, which saves each sheet as a separate PDF and names them as the sheet name plus some other cell data.

 

[elynoy]

Thank you for your help. I did what you said but If I change the code related to the second part of what you said so it wont prompt for each save, It wont work. Can you tell me how to achieve it?

eLy

 

[Logit]

Option Explicit


Sub createPDFfiles()
    Dim ws As Worksheet
    Dim Fname As String
    For Each ws In ActiveWorkbook.Worksheets
        On Error Resume Next 'Continue if an error occurs


        ' Name PDF files based on the worksheet Index
        Fname = "Sheet" & ws.Index & " " & Sheets("Sheet1").Range("C17").Value
        
        ws.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Fname, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False
    Next ws
End Sub

 

[elynoy]

your code works, but it gives me "sheet1", "sheet2".. I need the sheet name itself.

eLy

 

[elynoy]

I got it to work. This is how it is in case someone ever needs something similar.

Option Explicit


Sub createPDFfiles()
    Dim ws As Worksheet
    Dim Fname As String
    For Each ws In ActiveWorkbook.Worksheets
        On Error Resume Next 'Continue if an error occurs


        ' Name PDF files based on the worksheet Index
       Fname = ws.Name & "_" & Sheets("Alterações").Range("C17").Value
        
        ws.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Fname, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False
    Next ws
End Sub

Thanks everyone.

Best regards,
eLy

 

[elynoy]

sorry, I just noticed that this saves the file in "My documents". I need it to save on the same folder as the workbook or at least let me choose like the first exemple I gave in the first post.

eLy

 

[Logit]

.
Try this :

Option Explicit


Sub createPDFfiles()
    Dim ws As Worksheet
    Dim fname As String
    Dim myPath As String
    
    myPath = ThisWorkbook.Path
    Application.ScreenUpdating = False
    
    For Each ws In ActiveWorkbook.Worksheets
        
            On Error Resume Next 'Continue if an error occurs
    
            ' Name PDF files based on the worksheet Index
            fname = ws.Name & " " & Sheets("X").Range("C17").Value
    
            'PDF files are saved to same location as this workbook.
            '
            ws.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=myPath & "\" & fname & ".pdf", _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False
        
    Next ws
    Application.ScreenUpdating = True
    
    MsgBox "Process completed. PDF files located in Workbook Folder. ", vbInformation, "Process Complete"
End Sub

 

[elynoy]

your code only returns the success message and wont do anything. but thanks for your herlp.

I ended up with this after i change the path. In case someone needs this:

Private Sub SaveAsPdfALL()    
    Dim ws As Worksheet
    Dim Fname As String
   
    For Each ws In ActiveWorkbook.Worksheets
        On Error Resume Next 'Continue if an error occurs


        ' Name PDF files based on the worksheet Index
       Fname = ThisWorkbook.Path & "\" & ws.Name & "_" & Sheets("SHEETXYZ").Range("C17").Value
        
        ws.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Fname, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False
    Next ws
End Sub

Best regards,
eLy

 

[Logit]

.
If the worksheets are blank, they won't be saved as a PDF. There must be some kind of data on each sheet in order for it to be saved.

The macro I posted works here - when there is data on each sheet. There is no need to save an empty sheet.