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
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
Code language: VB.NET (vbnet)