Forum - Γενικά δημιουργία αρχείων word απο κελιά του excel

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

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

- - [Γενικά] δημιουργία αρχείων word απο κελιά του excel (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/5117-dimioyrgia-arxeion-word-apo-kelia-toy-excel.html)

Καλημέρα
Πάμε να δούμε ολοκληρωμένα, το σενάριο.

Γενικά
Έστω το πρότυπο Word (WRdoc) και το αρχείο Excel (XLbook), όπως στα συνημμένα...
Επιλέγουμε ή δημιουργούμε κάποιους φακέλους,
για να τα αποθηκεύσουμε στον υπολογιστή μας.

Πριν απ' όλα
Ανοίγουμε το excel αρχείο και πάμε με Alt + F11, στο περιβάλλον vba.
Ανοίγουμε την λειτουργική μονάδα mdl_Settings
Συμπληρώνουμε με προσοχή, τις διαδρομές των αρχείων
και τους αριθμούς, στήλης γραμμής (default = γραμμή 2, στήλη 1)

Αν δεν χρησιμοποιήσουμε το αρχείο του παραδείγματος,
μετονομάζουμε, το κωδικό όνομα του φύλλου που θα έχουμε τα ονόματα,
ως Sh1, σε όποιο άλλο δικό μας αρχείο.

Τι κάνει
Με τα πλήκτρα, έχουμε τα εξής:
1. Δημιουργία αρχείων, με ονομασία από κάθε κελί της a στήλης,
και αποθήκευση στον φάκελο.
*Δεν πρέπει να έχουμε κενές γραμμές (μνμ λάθους)
*Δεν πρέπει να χρησιμοποιήσουμε μη επιτρεπτούς χαρακτήρες (μνμ λάθους)
*Αν και καλό είναι να μην έχουμε διπλότυπα, αν υπάρξουν
τότε το νεότερο αρχείο, θα αντιγραφεί επάνω στο παλαιότερο.
2. Άνοιγμα του φακέλου αρχείων.

Με διπλό κλικ στα ονόματα:
Ανοίγει το επιλεγμένο αρχείο.

καλημέρα! προσπάθησα να προσαρμόσω τον κώδικα στο δικο μου αρχείο αλλά δεν τα κατάφερα, οπότε είπα να δουλέψω μέχρι να καταλάβω τι γίνεται με το συνημμένο. Ενώ δημιουργούνται κανονικά τα αρχεία πρόσεξα δυο πράγμα. Αρχικά παρόλο που δημιουργήθηκαν κανονικά τα αρχεία όταν πατάω σε ένα όνομα στο excel μου βγάζει οτι το αρχείο δεν υπάρχει. Επιπλέον αν γράψω κάτι σε κάποιο από τα word και μετά χρειαστεί να μπει καινούριο κελί στο excel, με το που δημιουργηθούν ξανά τα αρχεία (για να βάλω και το καινούριο όνομα) χάνεται ότι έγραψα στα προηγούμενα (πρόσεξα οτι αυτό συμβαίνει και με τον κώδικα που μου έδωσες χτες.). Πάντως θα το δουλέψω μέχρι να καταλάβω τι λάθος κάνω με την μεταφορά του κώδικα !!!

ΣΕ ευχαριστώ πολύ για την βοήθεια και τον χρόνο που διέθεσες!!!

Όσον αφορά «το αρχείο δεν υπάρχει»,
κάνεις σίγουρα λάθος στο path.

Για το θέμα που ενώ κάνεις αλλαγές σε κάποιο αρχείο, μετά την επανεκκίνηση του κώδικα
με νέο/α όνομα/ατα
φυσικό είναι να χάνονται, γιατί το ζητούμενο,
λέει για δημιουργία αρχείων από το πρότυπο.
Δεν αναφέρει κάπου ότι αυτά θα υποστούν επεξεργασία...

Θα πρέπει να αλλάξει ο κώδικας και να εξαιρεί τα υπάρχοντα,
ενώ θα δημιουργεί μόνο τα νέα...

κατάλαβα. Θα προσπαθήσω να βρω κάποιον τρόπο για να γίνεται η εξαίρεση. Πάντως (επειδή όπως κατάλαβες είμαι άσχετος με vba) αν κάποια στιγμή έχεις χρόνο θα με βοηθούσε πολύ να μου έλεγες τι αλλαγή πρέπει να κάνω στον κώδικα

Κώδικας:

Sub CopyWrdFile()

    Dim lrow As Long

    lrow = Φύλλο1.Cells(Rows.Count, 1).End(xlUp).Row

    

    Dim path1 As String

    path1 = "C:\Users\Administrator\Documents\Πρότυπα\Φόρμα.dotx"

    

    Dim wApp

    Set wApp = CreateObject("Word.Application")

    wApp.DisplayAlerts = False

    

    Dim wDoc

    Set wDoc = wApp.Documents.Add(Template:=path1, NewTemplate:=False, DocumentType:=0)

    

    Dim path2 As String, i As Long

    

    For i = 2 To lrow

        path2 = ThisWorkbook.Path & "\" & Range("a" & i).Value & ".docx"

        With wDoc

            wDoc.SaveAs Filename:=path2

        End With

    Next i

    

    wApp.DisplayAlerts = True

    wApp.Quit

    MsgBox "Done!"

End Sub

Ευχαριστώ και πάλι για όλα (αν και ξέρω ότι είναι πολύ λιγο το ευχαριστώ!)

Λοιπόν...
Πρώτα δες αν έχεις σωστά τα paths.

Μετά πάμε στην ρουτίνα CreateWRDFiles
Πάμε στο σημείο:

Κώδικας:

For i = iStartRow To lgLRow

και διέγραψε το όλο, μέχρι και το:

Κώδικας:

Next i

Στην θέση του βάλε:

Κώδικας:

    For i = iStartRow To lgLRow

        xlPath = ThisWorkbook.Path & "\" & Sh1.Cells(i, iCol).Value & ".docx"

        If Dir(xlPath) <> "" Then GoTo cnt_Here:

        With wDoc

        On Error GoTo AbandonShip:

            wDoc.SaveAs Filename:=xlPath

        End With

cnt_Here:

    Next i

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

Σ ευχαριστώ πολύ!!Όλα δούλεψαν ρολόι!!

Καλή συνέχεια και καλή χρονιά!

Καλή χρονιά και σε εσένα με υγεία!