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)

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

Ηλία μπορείς να αντιγράψεις τον παρακάτω κώδικα σε μια λειτουργική μονάδα (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).

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

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

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