Εμφάνιση ενός μόνο μηνύματος
  #11  
Παλιά 22-12-20, 15:51
Το avatar του χρήστη Tasos
Tasos Ο χρήστης Tasos δεν είναι συνδεδεμένος
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.035
Προεπιλογή

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

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

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση