Excel ile otomatik word dosyaları oluşturmak

[ismail157]

Merhaba,
Makro kodları ile excelde A sütununda yer alan isimler kadar masaüstünde belirli bir klasör içine word dosyası oluşturmak istiyorum bunu nasıl yapabilirim yardımcı olursanız sevinirim.
Örneğin A sütununda A1:A5 arası a,b,c,d,e yazıyor olsun bu yazan isimler ile boş word dosyası oluşturmam lazım bu A1:A5 arasında yer alan değerler sadece word dosyasının ismini oluşturacak. a.doc , b.doc, c.doc, d.doc, e.doc şeklinde 5 adet word dosyası

 

[hamitcan]

Aşağıdaki kodu deneyin.

Sub WordDosyasiOlusturma()
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim i As Integer
    Set wrdApp = CreateObject("Word.Application")
            For i = 1 To 5
                Set wrdDoc = wrdApp.Documents.Add
                With wrdDoc
                    If Dir("C:\Users\...\Desktop\" & Cells(i, 1) & ".docx") <> "" Then
                         Kill "C:\Users\...\Desktop\" & Cells(i, 1) & ".docx"
                    End If
                        .SaveAs ("C:\Users\...\Desktop\" & Cells(i, 1) & ".docx")
                        .Close
                End With
            Next
            MsgBox "Dosyalar Oluşturuldu."
End Sub

 

[ismail157]

Aşağıdaki kodu deneyin.

Sub WordDosyasiOlusturma()
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim i As Integer
    Set wrdApp = CreateObject("Word.Application")
            For i = 1 To 5
                Set wrdDoc = wrdApp.Documents.Add
                With wrdDoc
                    If Dir("C:\Users\...\Desktop\" & Cells(i, 1) & ".docx") <> "" Then
                         Kill "C:\Users\...\Desktop\" & Cells(i, 1) & ".docx"
                    End If
                        .SaveAs ("C:\Users\...\Desktop\" & Cells(i, 1) & ".docx")
                        .Close
                End With
            Next
            MsgBox "Dosyalar Oluşturuldu."
End Sub

Kodu çalıştırınca sonunda hata veriyor ama istediğim word dosyalarını oluşturuyor teşekkürler.
Bu kodu word yerine excel dosya oluşması için nasıl revize edebiliriz.

 

[hamitcan]

Not:"..." olarak görünen kısımları bilgisayar isminiz ile değiştirin.

Sub ExcelDosyasiOlusturma()
    Dim wrkApp As Excel.Application
    Dim wrkXls As Excel.Workbook
    Dim i As Integer
    Set wrkApp = CreateObject("excel.Application")
            For i = 1 To 5
                Set wrkXls = wrkApp.Workbooks.Add
                With wrkXls
                    If Dir("C:\Users\...\Desktop\" & Cells(i, 1) & ".xlsx") <> "" Then
                         Kill "C:\Users\...\Desktop\" & Cells(i, 1) & ".xlsx"
                    End If
                        .SaveAs ("C:\Users\...\Desktop\" & Cells(i, 1) & ".xlsx"), 51
                        .Close
                End With
            Next
            MsgBox "Dosyalar Oluşturuldu."
End Sub

 

[ismail157]

Çok çok teşekkürler çok güzel oldu bu