Excel VBA- Generate Report as PDF file

EXCEL VBA: TO EXPORT EXCEL SHEET AS PDF FILE

The following program can be used to export the active sheet into a PDF file. The logical steps used in below code are as follows:

1. Ask the user whether the active sheet should be converted into PDF file.
2. After affirmation, Save As dialog box appears.
3. The dialog box is used to provide save the PDF file at the desired location.
4. If already a PDF file exists with the name provided by the user, a serial number is appended at the end of the generated PDF file.

Sub pSheetSaveAsPDF()

    Dim WS As Worksheet

    Dim FTypeInfo As String

    Dim strFile As String

    Dim strFileWithout As String

    Dim FileCounter As Integer

    Dim strFilename As String

   

    Application.ScreenUpdating = False

    On Error GoTo XERR

   

    If MsgBox(ActiveSheet.Name & " will be converted into PDF File." & vbCrLf & _

        "Do you want to continue?", vbYesNo + vbInformation) = vbNo Then

        Exit Sub

    Else

        Set WS = ActiveSheet

        strFilename = ThisWorkbook.Path & Application.PathSeparator & WS.Name

        FTypeInfo = "PDF Files(*.PDF),*.PDF"

        strFile = Application.GetSaveAsFilename(InitialFileName:=strFilename, FileFilter:=FTypeInfo, _

            FilterIndex:=1, Title:="Choose a Folder Where the PDF File will be saved.")

        strFileWithout = Left(strFile, Len(strFile) - 4)

   

        Do While IsFileExists(strFile)

            FileCounter = FileCounter + 1

            strFile = strFileWithout & "(" & FileCounter & ").PDF"

        Loop

   

        WS.ExportAsFixedFormat xlTypePDF, strFile

    End If

   

XERR:

    If Err.Number <> 0 And Err.Number = 1004 Then

        MsgBox "There is no data to convert Active Sheet into PDF file.", vbInformation

        Exit Sub

    End If

    Application.ScreenUpdating = True

End Sub

   

    Function IsFileExists(strFilePath) As Boolean

            If Len(Dir(strFilePath)) <> 0 Then

                        IsFileExists = True

            End If

    End Function