Forum

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)

jimis 27-12-18 17:42
δημιουργία αρχείων word απο κελιά του excel
 
Καλησπέρα και Χρόνια πολλά!

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

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

Spirosgr 27-12-18 20:03
Καλησπέρα και Χρόνια πολλά!
Ο κώδικας πιο κάτω, κάνει το εξής:

Έστω ένα αρχείο 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

jimis 27-12-18 22:02
σε ευχαριστώ πολύ για την απάντηση σου! δυστυχώς μου βγάζει σφάλμα

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

Κώδικας:
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. μπορείς να καταλάβεις τι λάθος κάνω;

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

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


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

jimis 27-12-18 23:12
1 Συνημμένο(α)
Τα έκανα όλα όπως μου είπες και βγάζει πάλι σφάλμα. Συγκεκριμένα έφτιαξα έναν νέο φάκελο στα έγραφα με το όνομα Πρότυπα και έβαλα εκεί το αρχειο Φόρμα.dotx. τα office είναι ελληνικά 2007

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

Στο προηγούμενο post, σου έδωσα και ολόκληρο το string του path, ως:
Κώδικας:
C:\Users\Όνομα Χρήστη\AppData\Roaming\Microsoft\Πρότυπα\Φόρμα.dotx
για την περίπτωση του να το βάλεις στα πρότυπα...

Spirosgr 27-12-18 23:44
Συμπληρωματικά
Επειδή πολλές φορές, η εφαρμογή Word,
μπορεί να παραμένει «ανοιχτή» στον task manager,
με αποτέλεσμα να δημιουργούνται κάποια προβλήματα
πχ αν θέλουμε να διαγράψουμε ένα αρχείο, να βγαίνει μνμ ότι:
«Δεν μπορεί να γίνει διαγραφή, γιατί το αρχείο είναι ανοιχτό σε άλλη εφαρμογή...κλπ»
βάλε και αυτήν την γραμμή:
Κώδικας:
wApp.Quit
πριν το MsgBox και είναι καλυμμένο και αυτό.

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

Spirosgr 27-12-18 23:51
Ως προς την προσθήκη ονομάτων δεν υπάρχει καμία περίπτωση, να έχει σφάλμα.
Κάτι δεν κάνεις καλά...
Για τον υπερσύνδεσμο, ναι γίνεται αλλά θα σου απαντήσω αύριο...

jimis 27-12-18 23:58
το ξανα έκανα (με επιπλεον ονομασίες) και όντως δεν έβγαλε σφάλμα δεν ξέρω τι λάθος είχα κάνει την πρώτη φόρα.

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

Spirosgr 28-12-18 10:31
2 Συνημμένο(α)
Καλημέρα
Πάμε να δούμε ολοκληρωμένα, το σενάριο.

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

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

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

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

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

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

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

Spirosgr 28-12-18 11:26
Όσον αφορά «το αρχείο δεν υπάρχει»,
κάνεις σίγουρα λάθος στο path.

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

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

jimis 28-12-18 11:44
κατάλαβα. Θα προσπαθήσω να βρω κάποιον τρόπο για να γίνεται η εξαίρεση. Πάντως (επειδή όπως κατάλαβες είμαι άσχετος με 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
Ευχαριστώ και πάλι για όλα (αν και ξέρω ότι είναι πολύ λιγο το ευχαριστώ!)

Spirosgr 28-12-18 11:51
Λοιπόν...
Πρώτα δες αν έχεις σωστά τα 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
Από τώρα και στο εξής θα παραβλέπει ό,τι έχει δημιουργηθεί
και θα δημιουργεί μόνο τα νέα ονόματα.
Εννοείται δεν θα πειράζει και όποιες αλλαγές έγιναν στα παλιά...

jimis 28-12-18 16:14
Σ ευχαριστώ πολύ!!Όλα δούλεψαν ρολόι!!

Spirosgr 28-12-18 16:45
Καλή συνέχεια και καλή χρονιά!

jimis 28-12-18 23:40
Καλή χρονιά και σε εσένα με υγεία!


Η ώρα είναι 11:24.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2