Εμφάνιση ενός μόνο μηνύματος
  #2  
Παλιά 27-12-18, 20:03
Το avatar του χρήστη Spirosgr
Spirosgr Ο χρήστης Spirosgr δεν είναι συνδεδεμένος
Συντονιστής
Όνομα: Σπύρος Τσιλιγιάννης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013, Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 22-11-2011
Περιοχή: Αθήνα
Μηνύματα: 2.321
Προεπιλογή

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

Έστω ένα αρχείο 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
Απάντηση με παράθεση