Word’de Kişiselleştirilmiş Belgeler Oluşturma

Bu bölümde excel’den word’e kişiselleştirilmiş veri aktarmayı öğreneceğiz.

Aşağıdaki kodu Early Binding sistemiyle çalıştıracağımız için Word Nesnesi kitaplığı referansının seçili olması gerekir.

Öncelikle Makro dosyamızın bulunduğu klasörde Word_tasarim_dosyasi adında bir Word dosyası yaratıyoruz. Ekle -> Yer işaretleri (bookmark) bölümünden sayfanın hangi bölümüne veri eklememiz gerekiyorsa o alanlara yer işareti tanımlıyoruz. (Örneğin yer işareti 1: firmaadi, yer işareti 2: satislar)

Sub Worde_veri_aktarma() 

Dim WordUygulama As Word.Application 
Dim WordDosyasi As Word.Document 
Dim r As Long 
Dim DosyaAdi As String 

On Error Resume Next 
Set WordUygulama = GetObject(, "Word.Application") 
On Error GoTo HATA: 

If WordUygulama Is Nothing Then
     Set WordUygulama = New Word.Application 
End If 
WordUygulama.Visible = True 

DosyaAdi = ThisWorkbook.Path & "\Dosya_" 

r = 2 'başlangıç satırı 

Do Until IsEmpty(Cells(r, 1))
     Set WordDosyasi = WordUygulama.Documents.Open(ThisWorkbook.Path & "\Word_tasarim_dosyasi.docx")
     WordDosyasi.Bookmarks("firmaadi").Range.InsertAfter Cells(r, 1).Text
     WordDosyasi.Bookmarks("satislar").Range.InsertAfter Cells(r, 2).Text
     WordDosyasi.SaveAs2 DosyaAdi & Cells(r, 1).Text
     WordDosyasi.Close
     r = r + 1 
Loop 
Set WordUygulama = Nothing 

MsgBox "Kişiye özel word dosyaları oluşturuldu." & vbNewLine & _
       "Bu Çalışma Kitabı ile aynı klasöre kaydedildi.", vbInformation, "İşlem Tamamlandı" 
Exit Sub 

HATA: 
MsgBox "Hata: Lütfen yetkili kişiyle iletişime geçin", vbInformation, "Hata" 

End Sub Code language: VB.NET (vbnet)

Yukarıdaki makro kodu ile ilgili kişilere özel Word sayfaları oluşturulmuş oldu

Word'de Kişiselleştirilmiş Belgeler Oluşturma

Aşağıdaki komut InputBox metodu ile seçtiğimiz aralığı Word’e kopyalar:

Sub Worde_kopyalama() 

Dim WordUygulama As Word.Application 
Dim WordDosyasi As Word.Document 
Dim Kopyalama As Range 

On Error Resume Next 
Set WordUygulama = GetObject(, "Word.Application") 
On Error GoTo 0 

If WordUygulama Is Nothing Then
     Set WordUygulama = New Word.Application 
End If 

Set WordDosyasi = WordUygulama.Documents.Add 
Set Kopyalama = Application.InputBox("Lütfen aralığı seçin", "Lütfen aralığı seçin", , , , , , 8) 
Kopyalama.Copy 
WordUygulama.Selection.Paste 
WordUygulama.Visible = True 

Application.CutCopyMode = False 
Set WordUygulama = Nothing 

End SubCode language: VB.NET (vbnet)

Yayımlandı

kategorisi

yazarı:

Etiketler: