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

RBozkurt

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
569
Excel Vers. ve Dili
Microsoft Office 2016
Microsoft Office 2021
Google Sheets
İ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

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,802
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Dosyanız ekte.
Excel listesini baz alarak işlem yapıyor. "Şablon" ve "Tüm Liste" dosyalarının var olması gerekmiyor.
 

Ekli dosyalar

RBozkurt

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
569
Excel Vers. ve Dili
Microsoft Office 2016
Microsoft Office 2021
Google Sheets
Üyelik olmadığı için işlem yapamıyorum ilginize teşekkürler @dalgalikur
 

RBozkurt

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
569
Excel Vers. ve Dili
Microsoft Office 2016
Microsoft Office 2021
Google Sheets
Resimdeki hatayı vermekedir. Makroya izinde veriyorum.

 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,802
Excel Vers. ve Dili
2019 Türkçe
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

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
569
Excel Vers. ve Dili
Microsoft Office 2016
Microsoft Office 2021
Google Sheets
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
Kod:
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
 
Son düzenleme:

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,802
Excel Vers. ve Dili
2019 Türkçe
Excel listesindeki isim sıralaması ile "Tüm Sonuçlar" adlı dosyadaki isim sıralaması aynı mı?
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,802
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Bilgisayarımda bir arıza meydana geldi. Word çalıştıramıyorum.
Aşağıdaki kodları deneyin ben test edemedim.

Kod:
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

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
569
Excel Vers. ve Dili
Microsoft Office 2016
Microsoft Office 2021
Google Sheets
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.
 
Son düzenleme:
Üst