[Spirosgr]

Καλησπέρα
Στο ενεργό φύλλο κάνουμε προεπισκόπηση.
Ας υποθέσουμε ότι δημιουργούνται x σελίδες για εκτύπωση.
Αν οι κεφαλίδες στηλών είναι στην πρώτη γραμμή,
αυτές θα επαναληφθούν σε όλα τα pdf αρχεία.
Τα pdf αρχεία θα αποθηκευτούν σε φάκελο που θα ορίσουμε και
το όνομα τους θα είναι "κάτι" συν τον αριθμό σελίδας (1 έως x)

Sub SaveFileAsManyPDFasPages()

    Dim SavePath As String
    Dim FolderName As String
    Dim UName As String
    Dim WhereToSave As String
    Dim FileName As String
    Dim PrintRange As Range
    Dim HorizBR As Integer
    Dim VertBR As Integer
    Dim i As Integer
    Dim TotalPages As Integer

    Set PrintRange = Sheet1.Range("xPrintArea") 'Όνομα περιοχής εκτύπωσης

    HorizBR = ActiveSheet.HPageBreaks.Count + 1
    VertBR = ActiveSheet.VPageBreaks.Count + 1
    TotalPages = HorizBR * VertBR ' Σύνολο σελίδων οριζόντια και κάθετα
    UName = "Spirosgr" 'Όνομα χρήστη
    WhereToSave = "Desktop" 'Σημείο υπολογιστή που θα αποθηκευθεί
    FolderName = "myFolderName" 'Όνομα φακέλου αποθήκευσης
    FileName = "myFileName" 'Όνομα που θα έχει το αρχείο pdf
    'Το όνομα αυτό θα είναι myFileName1, 2, 3 ...κλπ όσες είναι οι σελίδες

    SavePath = "C:\Users\" & UName & "\" & WhereToSave & "\" & FolderName

    Application.PrintCommunication = False

    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1" 'Γραμμές που θα επαναληφθούν στον τίτλο
    End With
    Application.PrintCommunication = True

    For i = 1 To TotalPages
        PrintRange.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
                                       SavePath & "\" & FileName & i & ".pdf", Quality:= _
                                       xlQualityMinimum, IncludeDocProperties:=False, IgnorePrintAreas:=True, _
                                       From:=i, To:=i, OpenAfterPublish:=False
    Next i
    
End Sub