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

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

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 Sub

Paylaş: