Worde Aktarmada Sorun

06/02/2018, 11:50

hs1987

iyi günler Arkadaşlar;

kodu yazdım ancak birinci turu attıktan sonra sorun veriyor. Benim böyle 300-400 sayfa civarında veri oluşturmam gerekiyor. Nasıl çözüm bulabilirim?
06/02/2018, 12:09

ozanakkaya

Merhaba,

Word açtırma ve aktarma sonrası açık word belgesini kapatma işlemini döngü içerisine eklemeyi deneyiniz

Public Sub ExportNamesToWord()
   Dim wApp As Word.Application
   Dim wDoc As Word.Document
   Dim rs As DAO.Recordset
   
   
   Set rs = CurrentDb.OpenRecordset("deneme")
   
   If Not rs.EOF Then rs.MoveFirst
   
   Do Until rs.EOF
   
   Set wApp = New Word.Application
   Set wDoc = wApp.Documents.Open(CurrentProject.Path & "\Tutanak.docx")
   
       wDoc.Bookmarks("CikisTarih").Range.Text = Nz(rs!CikisTarih, "")
       wDoc.Bookmarks("TesisAdi").Range.Text = Nz(rs!TesisAdi, "")
       wDoc.Bookmarks("Plaka").Range.Text = Nz(rs!Plaka, "")
       wDoc.Bookmarks("Tonaj").Range.Text = Nz(rs!Tonaj, "")
       wDoc.SaveAs2 CurrentProject.Path & "\" & rs!ID & "_Tutanak.docx"
       
       wDoc.Bookmarks("CikisTarih").Range.Delete wdCharacter, Len(Nz(rs!CikisTarih, ""))
       wDoc.Bookmarks("TesisAdi").Range.Delete wdCharacter, Len(Nz(rs!TesisAdi, ""))
       wDoc.Bookmarks("Plaka").Range.Delete wdCharacter, Len(Nz(rs!Plaka, ""))
       wDoc.Bookmarks("Tonaj").Range.Delete wdCharacter, Len(Nz(rs!Tonaj, ""))
       
   wDoc.Close False
   wApp.Quit
   
   Set wDoc = Nothing
   Set wApp = Nothing
       
   rs.MoveNext
   Loop
   
   
   Set rs = Nothing
End Sub
07/02/2018, 09:06

hs1987

Çok teşekkür ederim. Bunların hepsini aynı anda yazdırma gibi bir makro ekleme şansım var mı?
07/02/2018, 10:54

ozanakkaya

Tablodaki kayıtları sırayla worde aktarıyor. Hepsini aynı anda aktaramazsın. Kayıtlar döngüye girmek zorunda.