- Katılım
- 12 Ocak 2009
- Mesajlar
- 838
- Excel Vers. ve Dili
- 2003
- Altın Üyelik Bitiş Tarihi
- 07-02-2024
Merhaba arkadaşlar.
Nette gezinirken personel izin takibi amacıyla yazılmış bir program denk geldi.
Bütün veriler access veritabanında tutuluyor, excelde userform aracılığı ile de veritabanına bağlanılıyor.
Ancak yazılımcı yeni kayıt yapma özelliğini bilinçli olarak eksik bırakmış.
Mantık olarak çok yerinde bir yöntem kullanmış. Excelde hiç bir veri tutulmadığı için şişme, kasma vs bir sorun teşkil etmiyor.
Amacım kişinin yazmış olduğu kodları veya programı sahiplenmek değildir. Alışılagelmiş excelde yapılmış programlarımı aynı mantıkla yeniden düzenleyebilmek ve access ile beraber sql'in nimetlerinden faydalanmak.
Programın algoritması şu şekilde;
Userform access database'ine bir şifre ile bağlanıyor.
Database bağlantısından sonra değiştir, sil işlemleri yapılabiliyor.
Burada yeni kayıt işlemleri yapılması gerekiyor.
Zamanı müsait olan arkadaşların yardımlarını rica ediyorum.
Nette gezinirken personel izin takibi amacıyla yazılmış bir program denk geldi.
Bütün veriler access veritabanında tutuluyor, excelde userform aracılığı ile de veritabanına bağlanılıyor.
Ancak yazılımcı yeni kayıt yapma özelliğini bilinçli olarak eksik bırakmış.
Mantık olarak çok yerinde bir yöntem kullanmış. Excelde hiç bir veri tutulmadığı için şişme, kasma vs bir sorun teşkil etmiyor.
Amacım kişinin yazmış olduğu kodları veya programı sahiplenmek değildir. Alışılagelmiş excelde yapılmış programlarımı aynı mantıkla yeniden düzenleyebilmek ve access ile beraber sql'in nimetlerinden faydalanmak.
Programın algoritması şu şekilde;
Userform access database'ine bir şifre ile bağlanıyor.
Kod:
Sub DbKontrol()
Dim Yoll As String
If Yoll = "" Then Yoll = ThisWorkbook.Path
DatabasePath = Yoll & "\database.mdb"
If Dir(DatabasePath) = "" Then
On Error Resume Next
MsgBox DatabasePath & " bulunamadı, programdan çıkılacak !", vbCritical, "....!"
Application.DisplayAlerts = False
Application.Visible = True
Application.Workbooks.Close
End If
End Sub
Sub DbAc()
Dim Yoll As String
If Yoll = "" Then Yoll = ThisWorkbook.Path
DatabasePath = Yoll & "\database.mdb"
On Error Resume Next
Set adoCN = CreateObject("ADODB.Connection")
If Val(Application.Version) >= 12 Then
adoCN.Provider = "Microsoft.ACE.OLEDB.12.0;Jet OLEDB:Database Password=Şifre;"
Else
'adoCN.Provider = "Microsoft.Jet.OLEDB.4.0"
adoCN.Provider = "Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=Şifre;"
End If
adoCN.ConnectionString = DatabasePath
adoCN.Open
End Sub
Kod:
Sub kaydet()
Dim i As Integer
Dim kaydetmodu As String
Dim basliklar()
Dim degerler(50) As Variant
degerler(0) = UserForm1.Controls("TextBoxPerIDX").Value: If degerler(0) = "" Then Exit Sub
degerler(1) = UserForm1.Controls("TextBox1").Value
'Call DbAc
strlog = "Select personel.idx, personel.ad From personel Where personel.idx=" & degerler(0)
Set RS = CreateObject("ADODB.recordset")
RS.Open strlog, adoCN, 1 ', 3
'Set RS = adoCN.Execute(strlog)
If RS.RecordCount > 0 Then
sor = MsgBox("Var olan " & degerler(1) & " personel noya ait kayıt değiştirilecek." & Chr(10) & "Devam edeyim mi ?", vbYesNo + vbInformation + vbDefaultButton2, "Dikkat")
If sor = vbNo Then Exit Sub
kaydetmodu = "degistir"
End If
RS.Close
Set RS = Nothing
basliklar = Array("idx", "per_no", "ad", "soyad", "ilk_soyad", "tc_kimlik_no", "cinsiyet", "dogum_tarihi", "dogum_yeri", "baba_ad", "ana_ad", "ise_giris_tarihi", "is_cikis_tarihi", "hafta_tatili", "statu", "medeni_hali", "ssk_no", "dept", "gorev", "tahsil", "meslek", "ev_tel", "is_tel", "cep_tel", "eposta", "adres", "adres_il", "adres_ilce", "kan_grubu", "nfs_seri", "nfs_no", "nfs_kay_il", "nfs_kay_ilce", "nfs_kay_mah_koy", "cilt_no", "aile_sno", "sira_no", "aciklama")
For i = 2 To 37
Select Case i
Case 6, 13, 14, 15, 17, 18, 19, 28
degerler(i) = UserForm1.Controls("ComboBox" & i).Value
Case Else
degerler(i) = UserForm1.Controls("TextBox" & i)
End Select
Next i
If degerler(1) = "" Or degerler(2) = "" Or degerler(3) = "" Then MsgBox "Personel No, Adı ve Soyadı boş olamaz..": Exit Sub
If degerler(7) = "" Or degerler(11) = "" Then MsgBox "Doğum tarihi ve İşe Giriş tarihi boş olamaz..": Exit Sub
If degerler(14) = "" Or degerler(17) = "" Then MsgBox "Statü ve Bölüm boş olamaz..": Exit Sub
strlog = "Select personel.idx, personel.ad From personel Where personel.per_no='" & degerler(1) & "'"
Set RS = CreateObject("ADODB.recordset")
RS.Open strlog, adoCN, 1 ', 3
'Set RS = adoCN.Execute(strlog)
If RS.RecordCount > 0 Then
RS.MoveFirst
Do While Not RS.EOF
If RS("idx") <> Val(degerler(0)) Then MsgBox "Aynı Personel Numarası ile kayıtlı bir kişi var!": Exit Sub
RS.MoveNext
Loop
End If
RS.Close
Set RS = Nothing
If kaydetmodu = "degistir" Then
strSQL = "UPDATE personel SET " & "personel." & basliklar(1) & " = '" & degerler(1) & "'"
For i = 2 To 37
Select Case i
Case 7, 11, 12
If degerler(i) = "" Then
strSQL = strSQL & ", " & "personel." & basliklar(i) & " =NULL"
Else
strSQL = strSQL & ", " & "personel." & basliklar(i) & " = '" & degerler(i) & "'"
End If
Case Else
strSQL = strSQL & ", " & "personel." & basliklar(i) & " = '" & degerler(i) & "'"
End Select
Next i
strSQL = strSQL & " WHERE personel.idx=" & degerler(0)
Else
' ............. kodlar
'.............. kodlar
MsgBox "Mesaj....", , "......."
End If
'MsgBox strSQL
On Error Resume Next
adoCN.Execute (strSQL)
'Call DbKapat
End Sub
Zamanı müsait olan arkadaşların yardımlarını rica ediyorum.
Ekli dosyalar
-
556.9 KB Görüntüleme: 66