[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

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

Τάσος