
22-12-20, 15:51
|
 | Διαχειριστής Όνομα: Τάσος Φιλοξενιδης Έκδοση λογισμικού 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 Ανάπτυξη επαγγελματικών εφαρμογών |