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

 

[elynoy]

I'm sorry. It didnt do anything for me. I simply copy/paste your code and edited the sheet name wich have data because it was in my "real" file.

Thanks for your help. Its finished now.

eLy

 

[Logit]

.
Sorry it didn't work for you. Glad you found a solution.

 

[elynoy]

Hello again. Is it possible to choose wich sheets to print? I tried

sheets(array("sheet1", "sheet2,")).select

but cant get it to work

Best regards
eLy

 

[Logit]

.

Option Explicit


Sub PrintReport()
'
' PrintReport Macro
'
Dim ary As Variant
Dim a As Variant
On Error Resume Next


ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
ary = Array("Cover Letter", "Well Info", "Pump Schedule")


    For Each a In ary
        Sheets(a).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Next a
End Sub


Sub PrntAll()
'This type macro requires the sheets to be listed in reverse order so final printed order is correct.
    ActiveSheet.PrintOut
    Worksheets(Array("Pump Schedule", "Well Info", "Cover Letter")).PrintOut
End Sub

 

[elynoy]

Sorry, I said print but it was supposed to be save as pdf and not actually use a printer.

 

[Logit]

.

Option Explicit


Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
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 = Format(Now(), "yyyymmdd\_hhmm")


'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
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If


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

You first select the sheet / s you want saved as PDF. Click the command button connected to this macro and the SaveAs dialog window opens where you
select the location for the PDF to be saved. Click OK and you are done.

 

[elynoy]

I thank you for your help but that code seems to be the one in my first post os this topic. I used a simpler one as i dont need to choose all that. I was hoping for a mix between my thIrd option wich is the one i use now for all the sheets at once. But i really need one option for selected sheets and the macro runs for those selected sheets instead of all of them. LIke i said before. I tried sheets(array("sheet1", "sheet2")). Select and it wont work.

 

[elynoy]

Ended up with this code:

Private Sub SaveCertainWorksheetsAsPDF()    
Dim sFileName As String, sht As Worksheet
    
    For Each sht In Worksheets
        If sht.Range("S1").Value = "print" Then
            With sht
                .ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:=ThisWorkbook.Path & "\" & sht.Name & "_" & Sheets("Alterações").Range("C17").Value, _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=False, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
            End With
        End If
    Next
End Sub

Not perfect since it need to have a value, in this case, "print" on cell S1 but then I hide it and it wont be saved in the pdf sheet.

Thanks for your help,
eLy