Option Explicit

' ToolsForEngineers.com
' Export all visible worksheets as separate PDF files.

Public Sub ExportVisibleSheetsToPDF()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim outFolder As String
    Dim pdfPath As String
    Dim exportedCount As Long

    Set wb = ActiveWorkbook
    If wb.Path = "" Then
        MsgBox "Please save the workbook first, then run the macro again.", vbExclamation, "PDF export"
        Exit Sub
    End If

    outFolder = wb.Path & Application.PathSeparator & "PDF_Exports"
    EnsureFolderExists outFolder

    Application.ScreenUpdating = False

    For Each ws In wb.Worksheets
        If ws.Visible = xlSheetVisible Then
            If Left$(ws.Name, 1) <> "_" Then
                PrepareSheetForPDF ws
                pdfPath = outFolder & Application.PathSeparator & CleanFileName(ws.Name) & ".pdf"
                ws.ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    Filename:=pdfPath, _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
                exportedCount = exportedCount + 1
            End If
        End If
    Next ws

    Application.ScreenUpdating = True

    MsgBox exportedCount & " PDF file(s) exported to:" & vbCrLf & outFolder, vbInformation, "PDF export complete"
End Sub

Private Sub PrepareSheetForPDF(ByVal ws As Worksheet)
    With ws.PageSetup
        .Orientation = xlLandscape
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .CenterHorizontally = True
        .LeftMargin = Application.InchesToPoints(0.35)
        .RightMargin = Application.InchesToPoints(0.35)
        .TopMargin = Application.InchesToPoints(0.45)
        .BottomMargin = Application.InchesToPoints(0.45)
        .HeaderMargin = Application.InchesToPoints(0.2)
        .FooterMargin = Application.InchesToPoints(0.2)
        .CenterFooter = "Page &P of &N"
    End With
End Sub

Private Sub EnsureFolderExists(ByVal folderPath As String)
    If Len(Dir(folderPath, vbDirectory)) = 0 Then MkDir folderPath
End Sub

Private Function CleanFileName(ByVal textValue As String) As String
    Dim badChars As Variant
    Dim i As Long

    badChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    CleanFileName = Trim$(textValue)

    For i = LBound(badChars) To UBound(badChars)
        CleanFileName = Replace(CleanFileName, badChars(i), "-")
    Next i

    If Len(CleanFileName) = 0 Then CleanFileName = "Sheet"
End Function