Excel'den Worde Aktarım Hk

[VecİK]

Merhaba, elimde 100 satırlık excel var bunu worde aktarmak istiyorum. Formdan yola çıkarak bir yere kadar geldim. Şu an sorunum tek satır olarak attı. İşime yaracak olan exceldeki 100 satırı 100 sayfa seklınde worde aktarmak. Yaptığım işlem ;+
NOT: Bunu yapmak istemem bir ayakkabı firmasında calısıyorum bilgiler excelden gelıyor. Etiket çıkarmak için worde tasarım yaptım. Tek sefer tüm içeriği aktarık barkod yazıcıdan cıkarmak ıstıyorum.
Private Sub CommandButton1_Click()
Dim doc As Word.Document
Set wordapp = CreateObject("word.application")
sablon = "C:\Users\ismail\Desktop\Test\sablon.docx"

For i = 2 To 110
Set doc = wordapp.Documents.Open(sablon)

doc.Bookmarks("KALITE").Range.InsertAfter Cells(i, 1)
doc.Bookmarks("MODEL").Range.InsertAfter Cells(i, 2)
doc.Bookmarks("RENK").Range.InsertAfter Cells(i, 3)
doc.Bookmarks("KIRK").Range.InsertAfter Cells(i, 4)
doc.Bookmarks("KIRKBIR").Range.InsertAfter Cells(i, 5)
doc.Bookmarks("KIRKIKI").Range.InsertAfter Cells(i, 6)
doc.Bookmarks("KIRKUC").Range.InsertAfter Cells(i, 7)
doc.Bookmarks("KIRKDORT").Range.InsertAfter Cells(i, 8)
doc.Bookmarks("KIRKBES").Range.InsertAfter Cells(i, 9)
doc.Bookmarks("Toplam").Range.InsertAfter Cells(i, 10)
doc.Bookmarks("MKOD").Range.InsertAfter Cells(i, 11)
doc.SaveAs2 "C:\Users\ismail\Desktop\Test\test.docx"

Next i

End Sub

 

[necati]

Merhaba,
Word ve excel dosyalarınızı paylaşım sitelerinden birine yükleyip linkini paylaşabilir misiniz?

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki satır dosyayı kaydediyor. Bunu bir satır aşağı alın

doc.SaveAs2 "C:\Users\ismail\Desktop\Test\test.docx"

Aşağıdaki gibi olmalı.

Private Sub CommandButton1_Click()
Dim doc As Word.Document
Set wordapp = CreateObject("word.application")
sablon = "C:\Users\ismail\Desktop\Test\sablon.docx"

For i = 2 To 110
Set doc = wordapp.Documents.Open(sablon)

doc.Bookmarks("KALITE").Range.InsertAfter Cells(i, 1)
doc.Bookmarks("MODEL").Range.InsertAfter Cells(i, 2)
doc.Bookmarks("RENK").Range.InsertAfter Cells(i, 3)
doc.Bookmarks("KIRK").Range.InsertAfter Cells(i, 4)
doc.Bookmarks("KIRKBIR").Range.InsertAfter Cells(i, 5)
doc.Bookmarks("KIRKIKI").Range.InsertAfter Cells(i, 6)
doc.Bookmarks("KIRKUC").Range.InsertAfter Cells(i, 7)
doc.Bookmarks("KIRKDORT").Range.InsertAfter Cells(i, 8)
doc.Bookmarks("KIRKBES").Range.InsertAfter Cells(i, 9)
doc.Bookmarks("Toplam").Range.InsertAfter Cells(i, 10)
doc.Bookmarks("MKOD").Range.InsertAfter Cells(i, 11)

Next i
doc.SaveAs2 "C:\Users\ismail\Desktop\Test\test.docx"
End Sub

 

[VecİK]

Merhaba, wetransfere ekledim link ; https://we.tl/t-BO02hbd0I0

 

[VecİK]

Merhaba.
Aşağıdaki satır dosyayı kaydediyor. Bunu bir satır aşağı alın

doc.SaveAs2 "C:\Users\ismail\Desktop\Test\test.docx"

Aşağıdaki gibi olmalı.

Private Sub CommandButton1_Click()
Dim doc As Word.Document
Set wordapp = CreateObject("word.application")
sablon = "C:\Users\ismail\Desktop\Test\sablon.docx"

For i = 2 To 110
Set doc = wordapp.Documents.Open(sablon)

doc.Bookmarks("KALITE").Range.InsertAfter Cells(i, 1)
doc.Bookmarks("MODEL").Range.InsertAfter Cells(i, 2)
doc.Bookmarks("RENK").Range.InsertAfter Cells(i, 3)
doc.Bookmarks("KIRK").Range.InsertAfter Cells(i, 4)
doc.Bookmarks("KIRKBIR").Range.InsertAfter Cells(i, 5)
doc.Bookmarks("KIRKIKI").Range.InsertAfter Cells(i, 6)
doc.Bookmarks("KIRKUC").Range.InsertAfter Cells(i, 7)
doc.Bookmarks("KIRKDORT").Range.InsertAfter Cells(i, 8)
doc.Bookmarks("KIRKBES").Range.InsertAfter Cells(i, 9)
doc.Bookmarks("Toplam").Range.InsertAfter Cells(i, 10)
doc.Bookmarks("MKOD").Range.InsertAfter Cells(i, 11)

Next i
doc.SaveAs2 "C:\Users\ismail\Desktop\Test\test.docx"
End Sub

Merhaba deneyeceğim

 

[necati]

Merhaba VecİK
Öncelikle sablon.docx 'deki yer imlerine girilmiş verileri silin.
sadece verileri, yer im işaretleri kalmalı.
Bir de en sona Toplam satırının altına bir adet boş satır ekleyin.

Private Sub CommandButton1_Click()
Dim wordapp As Object, doc As Object, i As Integer

Set wordapp = CreateObject("word.application")
sablon = "C:\Users\ismail\Desktop\Test\test.docx"
Set doc = wordapp.Documents.Open(sablon)
doc.Bookmarks("\page").Range.Copy

For i = 2 To 103
    doc.Bookmarks("KALITE").Range.InsertAfter Cells(i, 1)
    doc.Bookmarks("KALITE").Delete
    doc.Bookmarks("MODEL").Range.InsertAfter Cells(i, 2)
    doc.Bookmarks("MODEL").Delete
    doc.Bookmarks("RENK").Range.InsertAfter Cells(i, 3)
    doc.Bookmarks("RENK").Delete
    doc.Bookmarks("KIRK").Range.InsertAfter Cells(i, 4)
    doc.Bookmarks("KIRK").Delete
    doc.Bookmarks("KIRKBIR").Range.InsertAfter Cells(i, 5)
    doc.Bookmarks("KIRKBIR").Delete
    doc.Bookmarks("KIRKIKI").Range.InsertAfter Cells(i, 6)
    doc.Bookmarks("KIRKIKI").Delete
    doc.Bookmarks("KIRKUC").Range.InsertAfter Cells(i, 7)
    doc.Bookmarks("KIRKUC").Delete
    doc.Bookmarks("KIRKDORT").Range.InsertAfter Cells(i, 8)
    doc.Bookmarks("KIRKDORT").Delete
    doc.Bookmarks("KIRKBES").Range.InsertAfter Cells(i, 9)
    doc.Bookmarks("KIRKBES").Delete
    doc.Bookmarks("Toplam").Range.InsertAfter Cells(i, 10)
    doc.Bookmarks("Toplam").Delete
    doc.Bookmarks("MKOD").Range.InsertAfter Cells(i, 11)
    doc.Bookmarks("MKOD").Delete
    doc.sections.Add
    doc.sections.last.Range.Paste
Next i

doc.SaveAs2 "C:\Users\ismail\Desktop\Test\test_etiket.docx"
doc.Close False
Set doc = Nothing
wordapp.Quit
Set wordapp = Nothing

msgbox "İşlem tamamlandı",vbInformation

End Sub

 

[VecİK]

Necati bey run time erro 462 " doc.Bookmarks("Toplam").Range.InsertAfter Cells(i, 10)" bu satır sarı sekılde hata verdi. Birşey daha sormak istiyorum. Eğer wordde

 

[necati]

Bir de en sona Toplam satırının altına bir adet boş satır ekleyin diye bunun için yazmıştım.

 

[VecİK]

Necati Bey Günaydın, tam olarak anlayamadım. Bahsettiğiniz şablona mı? Bu konulara hakim değişim kusura bakmayın.

 

[necati]

Evet şablonunuza boş bir satır eklenecek. Yoksa sayfa çoğaltma esnasında son satırdaki toplam yer imini es geçip hata vermesine sebep oluyor.
Ben kod içinde "Test.docx" diye yazmışım ama sizdeki ismi farklı ise değiştirirsiniz.
Not: Word içinden adres mektup birleştir ile makrosuz daha kolay yapılabilir ama o konuya hakimiyetiniz nasıl?

 

[VecİK]

Necati Bey maalesef işte buradan formdan baktığım kadarıyla yapabiliyorum. Var mı önereceğim bu konuyla ilgili bir döküman?

 

[necati]

Makroyu kullanamadınız mı?
Adres mektup birleştirmek tarifi:
-Şablon word belgesi açalım
-Menüden "Postalar" menüsünü aç
-Adres mektup birleştirmeyi başlat'ı tıkla
-Mektuplar'ı tıkla
-Sağdaki menüye, "Alıcıları Seç" e geç
-Varolan listeyi kullan'ı tıkla
-Bilgisayarımdan kullanacağın Excel dosyanı seç (etiket blgilerinin kayıtlı olduğu dosya)
-veri kaynağını doğrula penceresi gelir. Burada 4 seçenek var, herhangi birini seç
-Menüden "Birleştirme alanı ekle" butonunu tıkla
-Excel sayfasındaki sütunların başlıkları gelir.
-Buradan istediklerini istediğin yere seçerek yerleştir.
-En sonunda Menüden "Bitir ve Belgeleri birleştir" butonunu tıkla
-Tek tek belgeleri düzenleyi tıkla
-"Tümü" dersen exceldeki tüm satırları ayrı ayrı sayfa halinde hazırlar.
-"Kaynak" dersen başlangıç ve bitiş sayısını girerek istediğin adette sayfa karşına gelir, hazırlanır.