Excel' den Word dosyasına bilgi aktarımı

[tamer42]

Merhaba,

Ekte yer alan Excel dosyasındaki Fatura bilgilerini Word dosyasına aktarmak istiyorum,

Excel dosyasıyla aynı klasörde yer alan Table Report.docx adındaki draft Word dosyasını açıp, Ürün Koduna göre farklı kaydet yaptıktan sonra;
excel dosyasındaki bilgileri word dosyasındaki karşılığına aktaracak ( word dosyasında sarı boyalı alanlar)

Not: Tarih alanı dosyanın oluşturma tarihi

Teşekkürler,

iyi çalışmaalr.

 

[Haluk]

Merhaba;

Alternatif olarak; söz konusu Word dokümanına bir kod yazdım. Bu kod, klasördeki verileri TableReport1.xlsx dosyasından gerekli verileri alıp, dokümandaki tablolara yerleştiriyor.

Kodların olduğu Word dosyasını, Excel dosyası ile aynı klasöre yerleştirip açtıktan sonra içindeki Test isimli makroyu çalıştırabilirsiniz.

.

 

[halit3]

Alternatif kod

referanslarda bu olmalı

Microsoft word 12.0 object library

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim objWord As Word.Application
Dim docWord As Word.Document


yol = ThisWorkbook.Path & "\Table Report.docx"

Set objWord = CreateObject("Word.Application")
objWord.Visible = True

Set docWord = objWord.Documents.Open(yol)

objWord.ActiveDocument.Tables(1).Rows(2).Cells(2).Tables(1).Rows(5).Cells(2).Range.Text = Date

objWord.ActiveDocument.Tables(2).Cell(2, 2).Range.Text = Cells(2, 1).Value
objWord.ActiveDocument.Tables(2).Cell(2, 3).Range.Text = Cells(2, 2).Value & " Adet"
objWord.ActiveDocument.Tables(2).Cell(2, 4).Range.Text = Format(Cells(2, 3).Value, "###.00") & " TL"

objWord.ActiveDocument.Tables(2).Cell(2, 9).Range.Text = Format(Cells(2, 7).Value, "###.00") & " TL"
objWord.ActiveDocument.Tables(2).Cell(2, 11).Range.Text = Format(Cells(2, 9).Value, "###.00") & " TL"


objWord.ActiveDocument.Tables(3).Cell(1, 3).Range.Text = Format(Cells(2, 10).Value, "###.00") & " TL"
objWord.ActiveDocument.Tables(3).Cell(3, 3).Range.Text = Format(Cells(2, 7).Value, "###.00") & " TL"
objWord.ActiveDocument.Tables(3).Cell(4, 3).Range.Text = Format(Cells(2, 10).Value, "###.00") & " TL"
objWord.ActiveDocument.Tables(3).Cell(5, 3).Range.Text = Format(Cells(2, 10).Value, "###.00") & " TL"


docWord.Save
docWord.Close False
objWord.Quit
Set docWord = Nothing

MsgBox "işlem tamam"


End Sub

 

[Haluk]

Alternatif kod

referanslarda bu olmalı

Microsoft word 12.0 object library

Halit bey;

Aşağıdaki satırı kullandığınıza göre, referans eklemenize gerek yok...... Zaten obj*** diye başlayan değişkenlerin Object olduğunu belirtmek için genelde böyle tanımlarım.

Set objWord = CreateObject("Word.Application")

objWord ve docWord değişkenlerini Object olarak tanımlamanız yeterli olurdu ....

.

 

[halit3]

Haluk Bey
Referansı sildiğimizde aşağıdaki bölümler hata veriyor.

Dim objWord As Word.Application
Dim docWord As Word.Document

bunlarıda sildiğimiz zaman kodları yazarken devamını göremiyorsunuz.

 

[Haluk]

Halit Bey;

Mesajımın son satırında değişkenleri Object olarak deklare etmenizin yeterli olacağını belirtmiştim, onu yapmadınız herhalde.

.

 

[halit3]

Haluk Bey kod bu haliyle referans istemeden işlemi yapacaktır ama ben şunu söylüyorum öğrenmek isteyenler için noktadan sonra makrolar olay yordamını gösteriyor bunun için böyle yapıyorum.
Ekli resimdeki kırmızı yerin çıkması için böyle yapıyorum.

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim objWord As Object
Dim docWord As Object

yol = ThisWorkbook.Path & "\Table Report.docx"

Set objWord = CreateObject("Word.Application")
objWord.Visible = True

Set docWord = objWord.Documents.Open(yol)

objWord.ActiveDocument.Tables(1).Rows(2).Cells(2).Tables(1).Rows(5).Cells(2).Range.Text = Date

objWord.ActiveDocument.Tables(2).Cell(2, 2).Range.Text = Cells(2, 1).Value
objWord.ActiveDocument.Tables(2).Cell(2, 3).Range.Text = Cells(2, 2).Value & " Adet"
objWord.ActiveDocument.Tables(2).Cell(2, 4).Range.Text = Format(Cells(2, 3).Value, "###.00") & " TL"

objWord.ActiveDocument.Tables(2).Cell(2, 9).Range.Text = Format(Cells(2, 7).Value, "###.00") & " TL"
objWord.ActiveDocument.Tables(2).Cell(2, 11).Range.Text = Format(Cells(2, 9).Value, "###.00") & " TL"


objWord.ActiveDocument.Tables(3).Cell(1, 3).Range.Text = Format(Cells(2, 10).Value, "###.00") & " TL"
objWord.ActiveDocument.Tables(3).Cell(3, 3).Range.Text = Format(Cells(2, 7).Value, "###.00") & " TL"
objWord.ActiveDocument.Tables(3).Cell(4, 3).Range.Text = Format(Cells(2, 10).Value, "###.00") & " TL"
objWord.ActiveDocument.Tables(3).Cell(5, 3).Range.Text = Format(Cells(2, 10).Value, "###.00") & " TL"


docWord.Save
docWord.Close False
objWord.Quit
Set docWord = Nothing

MsgBox "işlem tamam"


End Sub

 

[Haluk]

Halit Bey;

Sanırım ben anlatamadım, durum şöyle;

Siz kodlarda objWord ve docWord değişkenleri işin başında referans vererek tanımlıyorsunuz, buna itirazım yok.

Fakat, daha sonra referans verdiğiniz nesneleri bu kez CreateObject ile oluşturuyorsunuz. Benim işaret etmek istediğim nokta burası, yani;

Eğer işin başında projeye referans ekleyip de değişkenleri Word.Application ve Word.Document olarak tanımlıyorsanız, artık CreateObject kullanmamanız gerekir.

Onun yerine;

Set objWord = New Word.Application

kullanmanız gerekirdi.

Sizin kodda, söz konusu değişkenler hem Early Binding (kodun derleme sürecinde) hem de Late Binding (kodun çalışma sürecinde) olarak tanımlanıyor, oluşturuluyor. Yani, aynı işi 2 defa yapmak gibi ...

.

 

[halit3]

Tamam Haluk Bey şimdi anladım.

 

[tamer42]

Emekleriniz için çok teşekkür ederim,

"Table Report.docx" dosyası sabit olarak klasörde duracak, her seferinde bu dosya üzerinden çoğaltma yapacağız

"Table Report.docx" dosyası açıldıktan sonra "Table Report_123456ABC.doc" save as yapıp işlemlere bu dosya üzerinden devam edecek şekilde

iyi çalışamalar dilerim.

 

[halit3]

kod:

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim objWord As Word.Application
Dim docWord As Word.Document

yol = ThisWorkbook.Path & "\Table Report.docx"

Set objWord = CreateObject("Word.Application")
objWord.Visible = True

Set docWord = objWord.Documents.Open(yol)

objWord.ActiveDocument.Tables(1).Rows(2).Cells(2).Tables(1).Rows(5).Cells(2).Range.Text = Date

objWord.ActiveDocument.Tables(2).Cell(2, 2).Range.Text = Cells(2, 1).Value
objWord.ActiveDocument.Tables(2).Cell(2, 3).Range.Text = Cells(2, 2).Value & " Adet"
objWord.ActiveDocument.Tables(2).Cell(2, 4).Range.Text = Format(Cells(2, 3).Value, "###.00") & " TL"

objWord.ActiveDocument.Tables(2).Cell(2, 9).Range.Text = Format(Cells(2, 7).Value, "###.00") & " TL"
objWord.ActiveDocument.Tables(2).Cell(2, 11).Range.Text = Format(Cells(2, 9).Value, "###.00") & " TL"


objWord.ActiveDocument.Tables(3).Cell(1, 3).Range.Text = Format(Cells(2, 10).Value, "###.00") & " TL"
objWord.ActiveDocument.Tables(3).Cell(3, 3).Range.Text = Format(Cells(2, 7).Value, "###.00") & " TL"
objWord.ActiveDocument.Tables(3).Cell(4, 3).Range.Text = Format(Cells(2, 10).Value, "###.00") & " TL"
objWord.ActiveDocument.Tables(3).Cell(5, 3).Range.Text = Format(Cells(2, 10).Value, "###.00") & " TL"


yol2 = ThisWorkbook.Path & "\Table Report_123456ABC.doc"

docWord.SaveAs yol2
docWord.Close False
objWord.Quit
Set docWord = Nothing

MsgBox "işlem tamam"


End Sub

 

[exexciho]

Arkadaşlar sizin gibi şu kodları falan nasıl öğreneceğim ben O kadar detaylı word kullanamıyorum...