Option Explicit
' ----------------------------------------------------------------
' Procedure Name: PDFWorksheet
' Purpose: Create a PDF of statement worksheet.
' Procedure Kind: Sub
' Procedure Access: Public
' Parameter pwsSource (Worksheet): The "source" worksheet, => Customer Copy worksheet.
' Parameter psFolderToSaveIn (String): The folder where PDFs are stored: Full path.
' Parameter psName (String): The PDF file's name.
' Author: https://stackoverflow.com/questions/26392482/,
' Based on code from www.contextures.com
' Date: 10/10/2022
' ----------------------------------------------------------------
Sub PDFWorksheet(pwsSource As Worksheet, psFolderToSaveIn As String, psName As String)
Dim wbA As Workbook
Dim sTime As String
Dim sSheetName As String
Dim sPath As String
Dim sPDFFileName As String
Dim sFileSpec As String
Dim vFile As Variant
On Error GoTo errHandler
If psFolderToSaveIn = "" Then
psFolderToSaveIn = Application.DefaultFilePath
End If
' Add ending slash if it is not there.
If Right(psFolderToSaveIn, 1) <> "\" Then psFolderToSaveIn = psFolderToSaveIn & "\"
' Create name for the file to be saved. Use parameter psName.
If UCase(Right(psName, 4)) <> ".PDF" Then psName = psName & ".pdf"
' sPDFFileName = psName
sFileSpec = psFolderToSaveIn & psName
' Delete the file if it already exists.
On Error Resume Next
Kill (sFileSpec)
On Error GoTo 0
pwsSource.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sFileSpec, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file " & psName, vbCritical
Resume exitHandler
End Sub
'Sub PDFWorksheet(pwsSource As Worksheet, psFolderToSaveIn As String, psName As String)
'
' Dim wbA As Workbook
'
' Dim sTime As String
'
' Dim sSheetName As String
'
' Dim sPath As String
'
' Dim sPDFFileName As String
'
' Dim sFileSpec As String
'
' Dim vFile As Variant
'
' On Error GoTo errHandler
'
'' Folder to save in based on parameter value.
' sPath = psFolderToSaveIn
'
' If sPath = "" Then
' sPath = Application.DefaultFilePath
' End If
'
'' Add ending slash if needed.
' If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
'
'' Create name for the file to be saved. Use parameter psName.
' If UCase(Right(psName, 4)) <> ".PDF" Then psName = psName & ".pdf"
'
' sPDFFileName = psName
'
' sFileSpec = sPath & sPDFFileName
'
'' Delete the file if it already exists.
' On Error Resume Next
' Kill (sFileSpec)
' On Error GoTo 0
'
' pwsSource.ExportAsFixedFormat _
' Type:=xlTypePDF, _
' Filename:=sFileSpec, _
' Quality:=xlQualityStandard, _
' IncludeDocProperties:=True, _
' IgnorePrintAreas:=False, _
' OpenAfterPublish:=False
'
'exitHandler:
' Exit Sub
'errHandler:
' MsgBox "Could not create PDF file " & sPDFFileName
' Resume exitHandler
'End Sub