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

[Tasos]

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

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

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

Τάσος

[elias41]

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

[Tasos]

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

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

[elias41]

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

[Tasos]

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

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

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

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

[elias41]

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

[Tasos]

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