Forum - Εκτύπωση Αύξουσα ημερομηνία σε εκτύπωση πολλών αντιτύπων

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [Εκτύπωση] Αύξουσα ημερομηνία σε εκτύπωση πολλών αντιτύπων (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/5294-aiksoysa-imerominia-se-ektiposi-pollon-antitipon.html)

Αύξουσα ημερομηνία σε εκτύπωση πολλών αντιτύπων

Καλημέρα σε όλη την παρέα,
Έχω ένα ημερήσιο δελτίο εργασιών και θα ήθελα, εάν είναι εφικτό με κώδικα, δίνοντας για εκτύπωση 10 αντίτυπα του δελτίου στο κελί της ημερομηνίας να εκτυπώνεται η ημερομηνία με αύξουσα μορφή σε κάθε αντίτυπο, δηλ. 1ο αντιτ. 4/7/2019 , 2ο αντιτ. 5/7/2019....... .

Ευχαριστώ εκ των προτέρων
Φιλικά
Τίμος

Καλησπέρα Τίμο,

Έχεις κάποιο δείγμα του αρχείου που χρησιμοποιείς καθημερινά έτσι ώστε ο κώδικας να προσαρμοστεί ανάλογα στη δομή του;

Καλησπέρα Χρήστο,
Ανεβάζω το αρχείο. Είναι ένα ημερήσιο έντυπο εισόδου-εξόδου προσωπικού το οποίο θέλω να τυπώνω για κάθε μήνα με εκτυπωμένη την ημερομηνία για όλες τις μέρες του μήνα.

Καλησπέρα
Αλλάζουμε το βιβλίο σε .xlsm, για να μπορεί να εκτελεί κώδικα.
Ονομάζουμε το κελί που έχει την ημερομηνία πχ pDates
Βάζουμε τον πιο κάτω κώδικα, σε μια module:

Κώδικας:

Const startDate     As Date = "1/7/2019"
 Const endDate       As Date = "5/7/2019"
 Sub PrintContDates()

    Application.ScreenUpdating = False

    Dim printDate   As Date

    For printDate = startDate To endDate

        Range("pDates").Value = printDate
         'ActiveSheet.PrintPreview

        ActiveSheet.PrintOut

    Next

    'Range("pDates").Value = ""

    Application.ScreenUpdating = True
 End Sub

Το μόνο που χρειαζόμαστε είναι να βάλουμε στις σταθερές
όποιες ημερομηνίες θέλουμε για έναρξη-λήξη

Ο κώδικας εκτυπώνει το ενεργό φύλλο σε τόσα αντίτυπα
όσες και οι ημερομηνίες που βάλαμε.

Ο κώδικας δεν κάνει έλεγχο, αν οι ημερομηνίες είναι σωστές (πχ 30/2/2019)
ή αν η έναρξη είναι μεταγενέστερη από τη λήξη εκ παραδρομής...

Η πρώτη απενεργοποιημένη γραμμή, κάνει προεπισκόπηση (αν θέλουμε).
Η δεύτερη απενεργοποιημένη γραμμή, αφήνει κενό (αν θέλουμε) το κελί ημερομηνιών

Παράμετροι εκτύπωσης, manual από χρήστη.

Και μια πρόταση ακόμα με χρήση φόρμας (UserForm) μέσω κουμπιού.

Καλημέρα,
Ευχαριστώ και τους δυο σας για την άμεση ανταπόκριση. Οι λύσεις που προτείνατε, και οι δύο, δουλεύουν άψογα.
Και πάλι ευχαριστώ.

Φιλικά
Τίμος

Σπύρο,
Μία διευκρίνηση, υπάρχει δυνατότητα παρέμβασης-τροποποίησης στην λύση που πρότεινες ώστε οι startDate & endDate να παίρνουν τιμές από κελιά του φύλλου για να μην χρειάζεται να ανοίγεις κάθε φορά την VBA και να αλλάζεις τις ημερομηνίες?

Φιλικά
Τίμος

Ναι υπάρχει.
Πες μου, ποια κελιά σε βολεύουν και θα στο ετοιμάσω, όταν επιστρέψω σπίτι.

Καλησπέρα Σπύρο,
Στο επισυναπτόμενο αρχείο στο κελί Β3 να εκτυπώνεται η ημερομηνία. Στα κελιά Ο2 & Ρ2 να γράφω τις επιθυμητές ημερομηνίες από-μέχρι.
Ευχαριστώ για τον χρόνο σου.

Φιλικά
Τίμος

Καλησπέρα
Πάμε στον NameManager
Ονομάζουμε το κελί έναρξης sDate (o2)
Ονομάζουμε το κελί λήξης eDate (p2)
Ονομάζουμε το κελί ημερομηνίας pDate (b3)

Κώδικας:

Sub PrintContDates()

    Dim startDate   As Date

    Dim endDate     As Date

    Dim printDate   As Date
 

    Application.ScreenUpdating = False
 

    startDate = Range("sDate").Value

    endDate = Range("eDate").Value
 

    For printDate = startDate To endDate

        Range("pDates").Value = printDate
         'ActiveSheet.PrintPreview

        ActiveSheet.PrintOut

    Next printDate
 

    'Range("pDates").Value = ""

    Application.ScreenUpdating = True
 End Sub

Ισχύουν, όσα είπαμε στο post #4 περί σφαλμάτων κλπ.