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 απο κελιά του excel

Καλησπέρα και Χρόνια πολλά!

Για άλλη μια φορά θέλω την βοήθεια σας σε κάτι που προσπαθώ να κάνω που είναι λίγο περίπλοκο. Έχω ένα excel με μοναδικές ονομασίες στην στήλη Α (στο σύνολο περίπου 300 και πιθανόν στο μέλλον να προστεθούν και άλλα) και κάποιους αριθμούς στην στήλη Β. Αυτό που θέλω να πετύχω είναι να δημιουργούνται αυτόματα σε έναν φάκελο τόσα αρχεία word όσα και τα ονόματα στη στήλη Α με την αντίστοιχη ονομασία (δηλαδή αν το Α2 γράφει αστδφ και το word να ονομάζεται αστδφ) που θα αντιστοιχούν με υπερσύνδεσμο από τα κελιά του excel . Επιπλέον αν μπορεί να γίνει τα word να έχουν μια συγκεκριμένη μορφή από ένα πρότυπο που έχω δημιουργήσει (κουμπί office > δημιουργία > τα πρότυπα μου > δημιουργία νέου > πρότυπου > αποθήκευση στο C:\Users\Administrator\AppData\Roaming\Microsoft\� �ρότυπα). Γνωρίζεται αν μπορεί να γίνει κάτι τέτοιο ή ο μόνος τρόπος είναι με το χέρι ένα ένα;

Ευχαριστώ πολύ και με το καλό να έρθει το νέο έτος!

Καλησπέρα και Χρόνια πολλά!
Ο κώδικας πιο κάτω, κάνει το εξής:

Έστω ένα αρχείο Word, με όνομα This is a test.dotx
*η κατάληξη μπορεί να είναι οτιδήποτε
Έστω ένα αρχείο Excel, με όνομα Book1.xlsm
*η κατάληξη μπορεί να είναι οτιδήποτε μπορεί να διαχειριστεί μακροεντολές

Στο αρχείο Excel, στην πρώτη στήλη, έχουμε στο a1, μια κεφαλίδα και
από το a2 και κάτω, ονόματα μοναδικά (έστω 300)
*Θα πρέπει να προσέξουμε, τα ονόματα αυτά, πέρα από την μοναδικότητα,
να μην περιέχουν απαγορευμένους χαρακτήρες (< >/ \ ? : " *)

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

Κώδικας:

Sub CopyWrdFile()

    Dim lrow As Long

    lrow = Sh1.Cells(Rows.Count, 1).End(xlUp).Row

    

    Dim path1 As String

    path1 = "Διαδρομή αρχείου Word\This is a test.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

    MsgBox "Done!"

End Sub

Σημειώσεις (κόκκινο)
Όπου Sh1 = το κωδικό όνομα του φύλλου με τα ονόματα

Όπου 1 = αφορά την στήλη Α (μπορείτε να αλλάξετε, πχ με 3 για την στήλη C)

Διαδρομή αρχείου Word = Η Διαδρομή του αρχείου Word,
που ακολουθείται από το όνομα του σύν μια κατάληξη.

Όπου 2 = αφορά το κελί (γραμμή) που αρχίζουν τα ονόματα
Αν δεν υπάρχει κεφαλίδα, μπορείτε να αρχίσετε από το 1 (a1)
Αν έχετε κι άλλα δεδομένα, αντικαταστήστε ανάλογα
(πχ 5 αν τα ονόματα αρχίζουν από την 5η γραμμή)

ThisWorkbook.Path= Αν θέλετε τα αντίγραφα των αρχείων word,
να πάνε στον ίδιο φάκελο με το excel βιβλίο σας, μην κάνετε τίποτα.
Αν θέλετε να πάνε σε άλλο προορισμό, βάλτε στην θέση του, την διαδρομή που επιθυμείτε.

*Ο κώδικας δημιουργεί και αρχειοθετεί 300 αρχεία σε κάτι λιγότερο από 50 sec

σε ευχαριστώ πολύ για την απάντηση σου! δυστυχώς μου βγάζει σφάλμα

ποιο συγκεκριμένα έβαλα τον κώδικα ως εξής

Κώδικας:

Sub CopyWrdFile()

    Dim lrow As Long

    lrow = Öýëëï1 (εδώ σε εμένα γράφει Φύλλο1) .Cells(Rows.Count, 1).End(xlUp).Row

    

    Dim path1 As String

    path1 = "C:\Users\Administrator\AppData\Roaming\Microsoft\???t?pa\F??µa.dotx

   (σε εμένα γράφει  C:\Users\Administrator\AppData\Roaming\Microsoft\Πρότυπα\Φόρμα.dotx)\This is a test.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

    MsgBox "Done!"

End Sub

και πάτησα F5 για να τρέξει ο κωδικας. μου βγάζει μήνυμα σφάλματος "Run-time error '13': Type Mismatch. μπορείς να καταλάβεις τι λάθος κάνω;

Κατ' αρχάς ρίξε μια ματιά στην εικόνα.
Ό,τι είναι μέσα στην παρένθεση, αυτό πρέπει να μπεί στο lrow =.... (ώς φύλλο)
*είναι το κωδικό και όχι το φυσικό του όνομα (του φύλλου που έχει τα ονόματα)

Όσο για το path του word αρχείου, πρέπει να είναι:
*αν θέλεις να το βάλεις μαζί με τα πρόσθετα
C:\Users\Όνομα Χρήστη\AppData\Roaming\Microsoft\Addins\Φόρμα.dotx
Για Αγγλικό office
C:\Users\Όνομα Χρήστη\AppData\Roaming\Microsoft\Πρότυπα\Φόρμα.dotx
Για Ελληνικό office

Σημείωση
Επειδή ο AppData, είναι ένας «κρυφός» (σκιασμένος) φάκελος,
στους οποίους καλό είναι να μην πολυ μπαίνουμε αν δεν υπάρχει απόλυτη ανάγκη,
θα πρότεινα να βάλεις το word αρχείο (φόρμα), στα έγγραφά σου, σε ένα φάκελο που θα δημιουργήσεις για το σκοπό αυτό,
με όνομα της αρεσκείας σου (που φυσικά θα περιληφθεί στην διαδρομή)

Τα έκανα όλα όπως μου είπες και βγάζει πάλι σφάλμα. Συγκεκριμένα έφτιαξα έναν νέο φάκελο στα έγραφα με το όνομα Πρότυπα και έβαλα εκεί το αρχειο Φόρμα.dotx. τα office είναι ελληνικά 2007

Δημήτρη,
στις σημειώσεις του πρώτου post, έγραψα:
«Διαδρομή αρχείου Word = Η Διαδρομή του αρχείου Word,
που ακολουθείται από το όνομα του σύν μια κατάληξη.»
και εννοεί διαδρομή συν αυτό:
\This is a test.dotx (σαν παράδειγμα τίτλου συν κατάληξης)
Στον κώδικα, έχεις ξεχάσει να το αφαιρέσεις.
Βγάλτο και θα δουλέψει...

Στο προηγούμενο post, σου έδωσα και ολόκληρο το string του path, ως:

Κώδικας:

C:\Users\Όνομα Χρήστη\AppData\Roaming\Microsoft\Πρότυπα\Φόρμα.dotx

για την περίπτωση του να το βάλεις στα πρότυπα...

Συμπληρωματικά
Επειδή πολλές φορές, η εφαρμογή Word,
μπορεί να παραμένει «ανοιχτή» στον task manager,
με αποτέλεσμα να δημιουργούνται κάποια προβλήματα
πχ αν θέλουμε να διαγράψουμε ένα αρχείο, να βγαίνει μνμ ότι:
«Δεν μπορεί να γίνει διαγραφή, γιατί το αρχείο είναι ανοιχτό σε άλλη εφαρμογή...κλπ»
βάλε και αυτήν την γραμμή:

Κώδικας:

wApp.Quit

πριν το MsgBox και είναι καλυμμένο και αυτό.

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

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

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

Σε ευχαριστώ πολύ για όλη την βοήθεια!! Καλό βράδυ!