How to export from a Excel Sheet to a PDF file

If you are needing an way to export from a Excel Sheet to a PDF file, you just need to create a macro and assign to a button.

When you press the button you will have a popup asking for the base name of the Report and then you can select a name of sheets to print to pdf.

I use 2 especial sheets to work better the print and reduce the list

FromNowOn -> This worksheet is the markup from where I will considere the sheets to print (before this one all will be ignored in the List)

Off -> If you put "off" in the name of the sheet it will be ignored also.


Sub ExportExcelSheets()

    Dim ReportName As String
    Dim i As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim CurrentSheet As Worksheet
    Dim cb As CheckBox
    Dim myReportType As Variant
    Dim intPos As Integer
    Dim intStartPos As Integer
   
    Dim blnFirstAdded As Boolean
    blnFirstAdded = False
   
    Dim ReleaseName As String
    ReleaseName = ThisWorkbook.Sheets("Macros").Range("C5")
    Dim intIndexSheet As Integer
    intIndexSheet = 0
    Dim strIndexStr1 As String
    Dim strIndexStr2 As String
   
    intStartPos = -1
    ReportName = "Testing Status for "
   
    Application.ScreenUpdating = False
    myReportType = InputBox("Insert Report Type", "Report Type", "Release " & ReleaseName)
'   Check for protected workbook
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Workbook is protected.", vbCritical
        Exit Sub
    End If
'   Add a temporary dialog sheet
    Set CurrentSheet = ActiveSheet
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add
    SheetCount = 0
'   Add the checkboxes
    TopPos = 40
    For i = 1 To ActiveWorkbook.Worksheets.Count
        Set CurrentSheet = ActiveWorkbook.Worksheets(i)
       
'       Validate if the string "off" is present
       
        intPos = -1
        intPos = InStr(1, UCase(CurrentSheet.Name), UCase("OFF"), vbTextCompare)
       
'       Defining the starting point
        If InStr(1, UCase(CurrentSheet.Name), UCase("FromNowOn"), vbTextCompare) > 0 Then
            intStartPos = CurrentSheet.Index()
        End If

'       Skip hidden sheets
        If CurrentSheet.Visible And intPos = 0 And intStartPos > -1 Then
            SheetCount = SheetCount + 1
            PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
            'PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Index & " - " & CurrentSheet.Name
            PrintDlg.CheckBoxes(SheetCount).Text = CurrentSheet.Name
            PrintDlg.CheckBoxes(SheetCount).Value = xlOn
            TopPos = TopPos + 13
        End If
    Next i

    ' PPI: Put in the first sheet for export
    Set CurrentSheet = ActiveWorkbook.Worksheets(intStartPos)
'   Move the OK and Cancel buttons
    PrintDlg.Buttons.Left = 240
'   Set dialog height, width, and caption
    With PrintDlg.DialogFrame
        .Height = Application.Max _
            (68, PrintDlg.DialogFrame.Top + TopPos - 34)
        .Width = 230
        .Caption = "Select sheets to print"
    End With
'   Change tab order of OK and Cancel buttons
'   so the 1st option button will have the focus
    PrintDlg.Buttons("Button 2").BringToFront
    PrintDlg.Buttons("Button 3").BringToFront
' ******************************
' * Export Process
' ******************************
'   Display the dialog box
    CurrentSheet.Activate
    Application.ScreenUpdating = True
       
    Dim arrSheets() As String
    Dim intArrPos As Integer
    intArrPos = 1
   
    ReDim arrSheets(40)
    intArrPos = 0
       
    If SheetCount <> 0 Then
        ' Inicia o dialog para validar as sheets a imprimir
        If PrintDlg.Show Then
            For Each cb In PrintDlg.CheckBoxes
                If cb.Value = xlOn Then
                   
                    ' Array de Sheets selecionadas
                    arrSheets(intArrPos) = cb.Caption
                    intArrPos = intArrPos + 1
                   
                    If (Not blnFirstAdded) Then
                        ThisWorkbook.Sheets(cb.Caption).Select (False)
                        blnFirstAdded = True
                    Else
                        ThisWorkbook.Sheets(cb.Caption).Select (False)
                    End If
                   
                End If
            Next cb
          
            Dim intMaxArrSheetsSelected As Integer
            intMaxArrSheetsSelected = intArrPos - 1
            
            Dim arrSheetsSelected() As String
            ReDim arrSheetsSelected(intMaxArrSheetsSelected)
            For intArrPos = 0 To intMaxArrSheetsSelected
             arrSheetsSelected(intArrPos) = arrSheets(intArrPos)
            Next intArrPos
            
            ThisWorkbook.Worksheets(arrSheetsSelected).Select
          
            ' PPI: For export selected
            With ActiveSheet
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ReportName & myReportType & " - Week (" & Format(Now(), "ww") & ") " & _
            Format(Now(), "ddmmyy") & " v" & Format(Now(), "hhmmss") & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=True
            End With
        End If
    Else
        MsgBox "Não existe nenhuma sheet."
    End If
    ThisWorkbook.Sheets(2).Activate
'   Delete temporary dialog sheet (without a warning)
    Application.DisplayAlerts = False
    PrintDlg.Delete

End Sub