Forum - VBA αποθήκευση ως pdf

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [VBA] αποθήκευση ως pdf (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/3451-apothikeysi-os-pdf.html)

αποθήκευση ως pdf

καλησπέρα σας,
θα ήθελα να κάνω μία ερώτηση, πως μπορώ να αποθηκεύσω με vba σε μορφή pdf με όνομα αρχείου τον αριθμό του τιμολογίου σε έναν συγκεκριμένο φάκελο.
Ευχαριστώ πολύ.

Καλησπέρα
Πλήρως παραμετροποιήσιμος κώδικας για αποθήκευση ως PDF
μιας περιοχής ενός φύλλου Excel.

Κώδικας:

Sub SaveFileAsPDF()

    Dim SavePath As String, FolderName As String

    Dim UName As String, WhereToSave As String

    Dim PrintRange As Range, FileName As Range
 

    Set PrintRange = Sheet1.Range("myPrintRange")'Όνομα περιοχής που θα εκτυπωθεί

    Set FileName = Sheet1.Range("myInvNumber")'Όνομα περιοχής που περιέχει Αρ. Τιμολογίου

    

    UName = "Spirosgr"'Όνομα χρήστη

    WhereToSave = "Desktop"'Σημείο υπολογιστή που θα αποθηκευθεί

    FolderName = "INVBackUp"'Όνομα φακέλου αποθήκευσης

    

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

    

    PrintRange.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _

                                   SavePath & "\" & FileName & ".pdf", Quality:= _

                                   xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _

                                   OpenAfterPublish:=False

End Sub

Αλλάξτε αν θέλετε και το xlQualityMinimum με το xlQualityStandard
για διαφορετική ποιότητα στο PDF
Όπου Sheet1. το κωδικό όνομα του φύλλου.
Όλες οι ονομασίες και οι παράμετροι πρέπει να ακολουθούν τους κανόνες ονομασίας
Παράδειγμα:
Δεν μπορείτε να ονομάσετε τον φάκελο αποθήκευσης INVBackUp/2014 αλλά
μπορείτε να τον ονομάσετε INVBackUp-2014

Σας ευχαριστώ πολύ για άλλη μία φορά για την βοήθεια.

Να 'σαι καλά!

Μια διευκρίνηση:
Σχετικά με το xlQualityMinimum και το xlQualityStandard.
Δεν έχει να κάνει με την έννοια, ποιότητα εκτύπωσης, καλύτερη ή χειρότερη, ως εμφάνιση του αρχείου PDF, όπως ένα Draft αρχείο, σε μια εκτύπωση σε χαρτί, αλλά πρόκειται, για τον όγκο του αρχείου.
Τα αρχεία με QualityMinimum, είναι πιο «ελαφρά» και έτσι
μπορούν να δημοσιευθούν στο internet ή να σταλούν ως email (για παράδειγμα) ευκολότερα.
Αν δεν προορίζεται η χρήση του αντιγράφου για δημοσίευση, τότε χρησιμοποιήστε QualityStandard.

Καλημέρα. Ευχαριστώ πολύ για τις πληροφορίες. Το ήθελα για αποστολή σε email, άρα το αφήνω όπως είναι.
Με εκτίμηση.

Καλημέρα στην παρέα του φόρουμ,
Με αφορμή την παρούσα ανάρτηση για αποθήκευση δηλαδή κάποιου φύλλου εργασίας σε pdf, θέλω να ρωτήσω πως θα μπορούσε κανείς να δημιουργήσει διαφορετικά pdf εάν το συγκεκριμένο φύλλο έχει αλλαγή σελίδων και το επιθυμητό είναι να δημιουργηθεί ξεχωριστό pdf αρχείο για κάθε σελίδα/ες όταν υπάρχει pagebreak.

Φιλικά
Δημήτρης

Καλησπέρα
Στο ενεργό φύλλο κάνουμε προεπισκόπηση.
Ας υποθέσουμε ότι δημιουργούνται 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

Σπύρο να είσαι καλά.
Σε ευχαριστώ για άλλη μία φορά για την ανταπόκριση σου.

Φιλικά
Δημήτρης

Καλησπέρα κι από εμένα.
Εγώ χρησιμοποιώ την παρακάτω συνάρτηση για να βγάζω σε .pdf τα τιμολόγια.
Θέλω όμως το όνομα εξαγωγής να είναι της μορφής TΠΥ (αριθμός τιμολογίου)-(ημερομηνία τιμολογίου).
ο αριθμός τιμολογίου είναι στη στήλη V9 και η ημερομηνία σε μορφή (22/12/2020) στη στήλη Ρ9. Στο αρχείο πρέπει να γίνει μετατροπή των "\" σε "." προφανώς.
Τι πρέπει να προσθέσω στο vba παρακάτω;

Sub SaveAsPDFOptions()

Dim saveLocation As String
saveLocation = "G:\..............\................\2020\antigrafo .pdf"

'Example using all the options
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=saveLocation, _
OpenAfterPublish:=True, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
Quality:=xlQualityStandard, _
From:=1, To:=1

End Sub

Καλησπέρα Ηλία,

Δοκίμασε την παρακάτω ακολουθία στη μεταβλητή saveLocation:
saveLocation = "G:\..............\................\2020\ΤΠ� � " & Range("V9").Value & "-" & Format(Range("P9").Value, "(dd.mm.yyyy)") & ".pdf"

Καλησπέρα σε όλους!

Ηλία μπορείς να αντιγράψεις τον παρακάτω κώδικα σε μια λειτουργική μονάδα (Module) και να κάνεις τις δοκιμές σου:

Κώδικας:

Option Explicit
 

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _

                                                     ByVal lpPath As String) As Long
 

Sub ExportWorksheetToPDF()

    Dim i As Integer

    Dim PDFFolder As String

    Dim strFilename As String

    Dim Ret As Long

    Dim strInvoiceNumber As String

    Dim StrDate As String

    Dim wks As Worksheet

    PDFFolder = ThisWorkbook.Path & "\PDF Files"    ' "Κάνε προσαρμογή όπου χρειαστεί.

    PDFFolder = Trim(PDFFolder)
 

    If Right(PDFFolder, 1) <> "\" Then PDFFolder = PDFFolder & "\"
 

    Ret = MakeSureDirectoryPathExists(PDFFolder)

    If Ret = 0 Then

        MsgBox "Ο φάκελος δεν μπορεί να δημιουργηθεί. Βεβαιωθήτε ότι έχετε επαρκή δικαιώματα " & _

               "για τη δημιουργία φακέλου και ότι το μήκος της διαδρομής δεν " & _

               "υπερβαίνει τους 255 χαρακτήρες.", vbExclamation, "Σφάλμα"

        Exit Sub

    End If
 

    ' Προσάρμοσε το όνομα του φύλλο αν δεν προκειται για το ενεργό φύλλο.

    ' Παράδειγμα: Set wks = ThisWorkbook.Worksheets("όνομα του φύλλου")

    Set wks = ActiveSheet

    If Len(Trim(wks.Range("V9"))) = 0 Then

        MsgBox "Συμπληρώστε αριθμό τιμολογίου για να συνεχίσετε.", vbExclamation, "Προσοχή!"

        Exit Sub

    ElseIf Len(Trim(wks.Range("p9"))) = 0 Then

        MsgBox "Συμπληρώστε την ημερομηνία του τιμολογίου για να συνεχίσετε.", vbExclamation, "Προσοχή!"

        Exit Sub

    ElseIf Not IsDate(wks.Range("p9").Value) Then

        MsgBox "Συμπληρώστε μία έγκυρη ημερομηνία τιμολογίου για να συνεχίσετε.", vbExclamation, "Προσοχή!"

        Exit Sub

    End If
 

    strInvoiceNumber = Trim(wks.Range("V9"))
 

    If IsNumeric(strInvoiceNumber) Then strInvoiceNumber = Format(CLng(strInvoiceNumber), "00000000")
 

    StrDate = Replace(Format(wks.Range("p9").Value, "dd-mm-yy"), "-", "_")
 

    '...V9 και η ημερομηνία σε μορφή (22/12/2020) στη στήλη Ρ9

    strFilename = PDFFolder & strInvoiceNumber & "_" & StrDate & ".pdf"

    

    If Dir(strFilename, vbDirectory) <> "" Then

        i = 1

        While Dir(strFilename, vbDirectory) <> ""

            i = i + 1

            strFilename = PDFFolder & strInvoiceNumber & "_" & StrDate & "_V" & i & ".pdf"

        Wend

    End If
 

    wks.ExportAsFixedFormat _

            Type:=xlTypePDF, Filename:=strFilename, OpenAfterPublish:=True, _

            IncludeDocProperties:=True, IgnorePrintAreas:=False, _

            Quality:=xlQualityStandard, From:=1, To:=1
 

End Sub

Καλή συνέχεια!

Τάσος

Ευχαριστώ πολύ για την άμεση απάντηση!!!
Το προσάρμοσα έτσι τον κώδικα και μου βγάζει το αρχείο σε "νο τπυ"-22.12.2020.
Πως μπορώ να προσθέσω τη λέξη ΤΠΥ μπροστά από το όνομα του αρχείου;

Κάνε αντικατάσταση του κώδικα:

Κώδικας:

strFilename = PDFFolder & "strInvoiceNumber & "_" & StrDate & ".pdf"

    

    If Dir(strFilename, vbDirectory) <> "" Then

        i = 1

        While Dir(strFilename, vbDirectory) <> ""

            i = i + 1

            strFilename = PDFFolder & strInvoiceNumber & "_" & StrDate & "_V" & i & ".pdf"

        Wend

    End If

με τον κώδικα:

Κώδικας:

strFilename = PDFFolder & "ΤΠΥ" & strInvoiceNumber & "_" & StrDate & ".pdf"

    

    If Dir(strFilename, vbDirectory) <> "" Then

        i = 1

        While Dir(strFilename, vbDirectory) <> ""

            i = i + 1

            strFilename = PDFFolder & "ΤΠΥ" & strInvoiceNumber & "_" & StrDate & "_V" & i & ".pdf"

        Wend

    End If

Το αντικατέστησα αλλά μου βγάζει μήνυμα 1004 και στο vba editor μου δείχνει ότι έχω λάθος στο τέλος.

Φίλε μου Ηλία,
προσπαθείς να αποθηκεύσεις αρχείο με όνομα που περιέχει "???" αντί για "ΤΠΥ"

Στα Windows δεν μπορεί να υπάρξει όνομα που να περιέχει χαρακτήρες όπως:

< (less than)
> (greater than)
: (colon)
" (double quote)
/ (forward slash)
\ (backslash)
| (vertical bar or pipe)
? (question mark)
* (asterisk)
καθώς και οι χαρακτήρες ASCII (0 έως 31).

Φρόντισε να έχεις γυρίσει το πληκτρολόγιο σου στα ελληνικά όταν κάνεις αντιγραφή / επικόλληση του κώδικα
ώστε να εμφανίζονται οι κανονικοί χαρακτήρες καθώς και το "ΤΠΥ" για να τρέξει ο κώδικας.

οκ.
το διόρθωσα.
ευχαριστώ πολύ!!!!!

Να είσαι καλά!