Çözüldü Excel-Word Postalar ve Ayrı Kaydetme Sorunu Hakkında

[RBozkurt]

İyi günler herkese.
Excelde oluşturup Worde postalar sekmesiyle oluşturduğumuz tutanaklar var. Sayısı oldukça fazla.
1 listede mesela 300 kişi bulunuyor.
Problemimiz şu şekildedir.
İşlem sonunda mesela listede 300 kişi olduğu için oluşan posta sonuçları 300 sayfa oluşuyor.
Fakat, bu sayfaları ayrı ayrı kaydedemiyoruz. Çalıştığımız dosyalar çok kalabalık ama referans olması için aynı mantıkta ek olarak dosya ekledim.

Burada yapmak istediğimiz oluşan tüm dosyası her sayfada farklı kişiler olduğu için ayrı ayrı olarak kaydetmek.
Örnek: Sıra - Ad - Soyad (1 - Ali Yeşil) gibi tek sayfa olarak kaydetmek.
Yardımcı olabilirseniz çok sevinirim teşekkürler.

Örnek: https://www.dosyaupload.com/ngiH

 

[Muzaffer Ali]

Merhaba.
Dosyanız ekte.
Excel listesini baz alarak işlem yapıyor. "Şablon" ve "Tüm Liste" dosyalarının var olması gerekmiyor.

 

[RBozkurt]

Üyelik olmadığı için işlem yapamıyorum ilginize teşekkürler @dalgalikur

 

[Muzaffer Ali]

Dikkat etmemişim.
Buradan indirebilirsiniz.

https://www.dosyaupload.com/ngk0

 

[RBozkurt]

Resimdeki hatayı vermekedir. Makroya izinde veriyorum.

 

[Muzaffer Ali]

Excel dosyanız açıkken ALT+F11 e basarak VBA yı açın.
"Tools" menüsünden "Referances" seçin.
Eğer listedeki seçili öğelerin yanında "Missing" yazıyorsa yanındaki tikini(işareti) kaldırın
Listeden "Microsoft Word" ile başlayan öğeyi bulup yanındaki tiki işaretleyin.
"OK" seçip pencereyi kapatın.
Şimdi hata vermeyecektir.

 

[RBozkurt]

Teşekkürler hata vermeden çalışıyor şuan. Sonuç belgeler istediğimiz gibi fakat şablon kullanılmadığı için mevcut çalışmamızı bu şekilde yapamayız.
Şablonu kullanarak oluşturulan tek dosyalık (x sayfa) belgeyi isim isim ayırmak mümkünmüdür.

Alttaki kodu bu linkte buldum ama çalıştıramadım.
Asıl aradığımız uygulama şekli bu. Kullandığımız şablon karmaşık bir yapıda. Tablo ve resimden oluşmakta. Kamuda çalışıyoruz şablonun aslını eklemem mümkün değil.

Edit:
Tam olarak bu

Sub BolumAyir()
‘Evrak icinde bolum-bolum gezmeyi ayarlamak için kullanilir.
Application.Browser.Target = wdBrowseSection

‘Mailings dosyalari bolum sonu ve yeni sayfa ile biter.
‘Bolum sayisindan bir cikarmak hata mesajini durdurur.
For i = 1 To ((ActiveDocument.Sections.Count) – 1)

‘Bolumu secip panoya kopyalar.
ActiveDocument.Bookmarks(“\Section”).Range.Copy

‘Yeni dokuman olustur ve panodan yapistir.
Documents.Add
Selection.Paste

‘Yapistirma islemi ile gelen (varsa) sayfa sonudaki bolum sonunu siler.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1

ChangeFileOpenDirectory “C:\KAYIT YAPILACAK DOSYA ADRESİ EKLENECEK”
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:=”test_” & DocNum & “.doc”
ActiveDocument.Close
‘Secimi dokuman icindeki bir sonraki bolume kaydir.
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

 

[Muzaffer Ali]

Excel listesindeki isim sıralaması ile "Tüm Sonuçlar" adlı dosyadaki isim sıralaması aynı mı?

 

[RBozkurt]

Excel listesindeki isim sıralaması ile "Tüm Sonuçlar" adlı dosyadaki isim sıralaması aynı mı?

Evet exceldeki sıra neyse oluşan evrak o sırada.

 

[Muzaffer Ali]

Merhaba.
Bilgisayarımda bir arıza meydana geldi. Word çalıştıramıyorum.
Aşağıdaki kodları deneyin ben test edemedim.

Private Sub CommandButton1_Click()
    Dim W_App As New Word.Application
    Dim Doc As Document
    Dim Bak As Integer
    W_App.Visible = True
    Set Doc = W_App.Documents.Open(ThisWorkbook.Path & "/3 - Tüm Sonuç.docx")
    For Bak = 2 To Cells(Rows.Count, "A").End(3).Row
        With W_App
            .Browser.Target = wdBrowseSection
            .ActiveDocument.Bookmarks("\Section").Range.Copy
            .Documents.Add
            .Selection.Paste
            .Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
            .Selection.Delete Unit:=wdCharacter, Count:=1
            .ActiveDocument.SaveAs Filename:=ThisWorkbook.Path & "/" & Cells(Bak, 1) & "- " & Cells(Bak, 2) & " " & Cells(Bak, 3)
            .ActiveDocument.Close
            .Browser.Next
            .ActiveDocument.Close savechanges:=wdDoNotSaveChanges
    Next
    Doc.Close False
    W_App.Quit
    MsgBox "Aktarma tamamlandı."
End Sub

 

[RBozkurt]

Görev nedeniyle geç dönüş yaptım. Malesef hata vermektedir.
Bu mesajımdaki edit kısmında paylaşılan yöntemi çözmeye çalışıyorum.

https://www.excel.web.tr/threads/dosya-yolu-ve-ismi-hakkinda.180979/
Konuya buradan devam edeceğim.
Eklediğim mesajdaki yöntem çalışmaktadır.
Videoyu 1 2 kez izleyip adımlar uygulanırsa ihtiyacı olan arkadaşlar kullanabilirler.
Kolay gelsin.