Yeni bir Paket Programlar dersi makalesi ile birlikteyiz.
Word programında ADODB ile Excel veri tabanına nasıl bağlanıldığını ve veri tabanı işlemlerinin nasıl gerçekleştiğini daha önceki makalelerde anlatmıştık. Öğrendiklerimizin tamamını kapsayan komplike bir uygulama yapalım. Üyelerin adres bilgilerinin tutulduğu bir Excel veri tabanı oluşturalım. Bu veri tabanına erişim ve diğer işlemleri Word programı üzerinden gerçekleştirelim.
Excel veri tabanında adrestakip.xls isimli bir çalışma kitabı oluşturalım. Bu çalışma kitabında rehber isimli bir çalışma sayfası oluşturalım. Bu çalışma sayfasında Durum, AdiSoyadi, Adres, Sehir, Telefon sütunlarını oluşturalım. Çalışma kitabımzın görünümü aşağıdaki gibi olacaktır.
Word programını açalım. Aşağıdaki gibi bir tablo oluşturalım. Belgemizi rehber.docm olarak kaydedlim.
Private Sub btnYeni_Click()
Me.ContentControls(1).Range.Text = ""
Me.ContentControls(2).Range.Text = ""
Me.ContentControls(3).Range.Text = ""
Me.ContentControls(4).Range.Text = ""
Me.ContentControls(1).Range.Select
End Sub
Private Sub btnKaydet_Click()
Dim baglan As ADODB.Connection
Dim kayit As ADODB.Recordset
Dim Nsql As String
Dim yol As String
yol = Me.Path & "\adrestakip.xls"
Set baglan = New ADODB.Connection
baglan.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & yol & ";Readonly=True"
Set kayit = New ADODB.Recordset
Nsql = "SELECT * FROM [rehber$]"
kayit.Open Nsql, baglan, 1, 3
kayit.AddNew
kayit("Durum") = "K"
kayit("AdiSoyadi") = ActiveDocument.ContentControls(1).Range.Text
kayit("Adres") = ActiveDocument.ContentControls(2).Range.Text
kayit("Sehir") = ActiveDocument.ContentControls(3).Range.Text
kayit("Telefon") = ActiveDocument.ContentControls(4).Range.Text
kayit.Update
baglan.Close
End Sub
Private Sub btnListele_Click()
Dim baglan As ADODB.Connection
Dim kayit As ADODB.Recordset
Dim Nsql As String
Dim yol As String
yol = Me.Path & "\adrestakip.xls"
Set baglan = New ADODB.Connection
baglan.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & yol & ";Readonly=True"
Set kayit = New ADODB.Recordset
Nsql = "SELECT * FROM [rehber$] WHERE Durum<>'S'"
kayit.Open Nsql, baglan, 1, 3
kayit.MoveFirst
lstListe.Clear
k = 0
Do While Not kayit.EOF
lstListe.AddItem kayit!AdiSoyadi
lstListe.List(k, 1) = kayit!Adres + " / " + kayit!Sehir
lstListe.List(k, 2) = kayit!Telefon
kayit.MoveNext
k = k + 1
Loop
Set kayit = Nothing
baglan.Close
End Sub
Private Sub lstListe_Click()
Dim baglan As ADODB.Connection
Dim kayit As ADODB.Recordset
Dim Nsql As String
Dim yol As String
yol = Me.Path & "\adrestakip.xls"
Set baglan = New ADODB.Connection
baglan.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & yol & ";Readonly=True"
Set kayit = New ADODB.Recordset
Nsql = "SELECT * FROM [rehber$] Where AdiSoyadi='" & lstListe & "'"
kayit.Open Nsql, baglan, 1, 3
ActiveDocument.ContentControls(1).Range.Text = kayit("AdiSoyadi")
ActiveDocument.ContentControls(2).Range.Text = kayit("Adres")
ActiveDocument.ContentControls(3).Range.Text = kayit("Sehir")
ActiveDocument.ContentControls(4).Range.Text = kayit("Telefon")
Set kayit = Nothing
baglan.Close
End Sub
Private Sub btnDuzelt_Click()
Dim baglan As ADODB.Connection
Dim kayit As ADODB.Recordset
Dim Nsql As String
Dim yol As String
yol = Me.Path & "\adrestakip.xls"
Set baglan = New ADODB.Connection
baglan.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & yol & ";Readonly=True"
Set kayit = New ADODB.Recordset
Nsql = "SELECT * FROM [rehber$] Where adisoyadi='" & lstListe & "'"
kayit.Open Nsql, baglan, 1, 3
kayit("durum") = "D"
kayit("adisoyadi") = ActiveDocument.ContentControls(1).Range.Text
kayit("adres") = ActiveDocument.ContentControls(2).Range.Text
kayit("sehir") = ActiveDocument.ContentControls(3).Range.Text
kayit("telefon") = ActiveDocument.ContentControls(4).Range.Text
kayit.Update
Set kayit = Nothing
baglan.Close
End Sub
Private Sub btnSil_Click()
Dim baglan As ADODB.Connection
Dim kayit As ADODB.Recordset
Dim Nsql As String
Dim yol As String
yol = Me.Path & "\adrestakip.xls"
Set baglan = New ADODB.Connection
baglan.Open "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & yol & ";Readonly=True"
Set kayit = New ADODB.Recordset
Nsql = "SELECT * FROM [rehber$] Where adisoyadi='" & lstListe & "'"
kayit.Open Nsql, baglan, 1, 3
kayit("durum") = "S"
kayit.Update
Set kayit = Nothing
baglan.Close
End Sub
Projeyi çalıştırdığınızda tüm butonları deneyebilir, kayıt işlemlerini gerçekleştirebilirsiniz.
Projeye ait dosyaları buradan indirebilirsiniz.