Arkadaşlar bu program market urunlerinin kaydını tutmak icin yazılmıştır. Urunlerin adını,adedini,fiyatını ve son kullanma tarihini kayıt eder. Kodlarını buraya ekliyorum. Programın calışan halini visual basic projesi olarak www.visualbasickod.hostwq.net adresinden indirebilirsiniz. Ozellikle kodla veritabanı işlemleri ile ilgili guzel bir uygulama. Kodları istediğiniz şekilde değiştirip kendinizde projeler hazırlayabilirsiniz. Program hakkında yorumlarınızı bekliyorum. Hepinize iyi calışmalar...

FORM1 e yazılacaklar

Dim databaseadi As String
Dim tabloadi As String
Dim ws As Workspace
Dim db As Database
Dim kayitseti As Recordset
Dim b, f
Private Sub Command1_Click()
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Then
MsgBox "Lutfen Urun Bilgilerini Tam Giriniz", vbExclamation, "Ekle"
Exit Sub
Else
kayitseti.AddNew
kayitseti![Urun Adi] = Text1.Text
kayitseti![Adedi] = Text2.Text
kayitseti![Fiyati] = Text3.Text
kayitseti![Tarihi] = Text4.Text
kayitseti.Update
Text11.Text = Text11.Text + 1
List1(0).Clear
List1(1).Clear
List1(2).Clear
List1(3).Clear
If kayitseti.RecordCount > 0 Then
kayitseti.MoveFirst
Do Until kayitseti.EOF
List1(0).AddItem kayitseti![Urun Adi]
List1(1).AddItem kayitseti![Adedi]
List1(2).AddItem kayitseti![Fiyati]
List1(3).AddItem kayitseti![Tarihi]
kayitseti.MoveNext
Loop
End If
End If
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
End Sub
Private Sub Command2_Click()
If Text5.Text = "" Then
MsgBox "Lutfen Aranacak Urun Adını Tam Olarak Giriniz", vbExclamation, "Ara"
Exit Sub
End If
For i = 0 To List1(0).ListCount - 1
If UCase(List1(0).List(i)) = UCase(Text5) Then
List1(0).ListIndex = i
Exit Sub
End If
Next
MsgBox "Aranan Urun Kayıtlarda Yok! Urun Adını Doğru Girdiğinizden Emin Olun", vbInformation, "Ara"
End Sub
Private Sub Command3_Click()
If List1(0).ListIndex < 0 Then
MsgBox "Silinecek Urunu Listeden Bulup Seciniz", vbExclamation, "Sil"
Exit Sub
End If
Command6_Click
End Sub
Private Sub Command5_Click()
Dim ad1, ad2, ad3, ad4
If List1(0).ListIndex < 0 Then
MsgBox "Değiştirilecek Urunu Listeden Bulup Seciniz", vbExclamation, "Değiştir"
Exit Sub
End If
ad1 = Text6.Text
ad2 = Text7.Text
ad3 = Text8.Text
ad4 = Text9.Text
Form2.Text1.Text = ad1
Form2.Text2.Text = ad2
Form2.Text3.Text = ad3
Form2.Text4.Text = ad4
Form2.Show
End Sub
Private Sub Command6_Click()
Dim c, ind1, ind2
kayitseti.MoveLast
kayitoku
ind1 = List1(0).ListIndex
c = MsgBox(List1(0).List(ind1) & " Silinsinmi?", vbYesNo + vbQuestion + vbDefaultButton2, "Sil")
If c = vbNo Then Exit Sub
Dim a
a = Text11.Text
ind2 = List1(0).ListIndex + 1
f = a - ind2
Text10.Text = f
For i = 1 To f
kayitseti.MovePrevious
Next
kayitoku
kayitseti.Delete
Text11.Text = kayitseti.RecordCount
List1(0).RemoveItem ind1
List1(1).RemoveItem ind1
List1(2).RemoveItem ind1
List1(3).RemoveItem ind1
Exit Sub
End Sub
Private Sub Form_Load()
databaseadi = "stok2.mdb"
tabloadi = "Stok"
Set ws = DBEngine.CreateWorkspace("dbtemp", "admin", "")
Set db = ws.OpenDatabase(databaseadi)
Set kayitseti = db.OpenRecordset(tabloadi, dbOpenTable)
Text11.Text = kayitseti.RecordCount
kayitoku
If kayitseti.RecordCount > 0 Then
kayitseti.MoveFirst
Do Until kayitseti.EOF
List1(0).AddItem kayitseti![Urun Adi]
List1(1).AddItem kayitseti![Adedi]
List1(2).AddItem kayitseti![Fiyati]
List1(3).AddItem kayitseti![Tarihi]
kayitseti.MoveNext
Loop
End If
End Sub
Public Sub kayitoku()
On Error Resume Next
Text6 = kayitseti.Fields(0)
Text7 = kayitseti.Fields(1)
Text8 = kayitseti.Fields(2)
Text9 = kayitseti.Fields(3)
End Sub
Public Sub degistir()
Dim ind1, ind2
kayitseti.MoveLast
kayitoku
ind1 = List1(0).ListIndex
Dim a
a = Text11.Text
ind2 = List1(0).ListIndex + 1
f = a - ind2
Text10.Text = f
For i = 1 To f
kayitseti.MovePrevious
Next
kayitoku
kayitseti.Edit
kayitseti![Urun Adi] = Form2.Text1.Text
kayitseti![Adedi] = Form2.Text2.Text
kayitseti![Fiyati] = Form2.Text3.Text
kayitseti![Tarihi] = Form2.Text4.Text
kayitseti.Update
List1(0).Clear
List1(1).Clear
List1(2).Clear
List1(3).Clear
If kayitseti.RecordCount > 0 Then
kayitseti.MoveFirst
Do Until kayitseti.EOF
List1(0).AddItem kayitseti![Urun Adi]
List1(1).AddItem kayitseti![Adedi]
List1(2).AddItem kayitseti![Fiyati]
List1(3).AddItem kayitseti![Tarihi]
kayitseti.MoveNext
Loop
Form2.Text1.Text = ""
Form2.Text2.Text = ""
Form2.Text3.Text = ""
Form2.Text4.Text = ""
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
kayitseti.Close
db.Close
Set kayitseti = Nothing
Set db = Nothing
End Sub
Private Sub List1_Click(Index As Integer)
Dim ind, tind, aranan
tind = List1(Index).TopIndex
ind = List1(Index).ListIndex
For i = 0 To 3
List1(i).ListIndex = ind
List1(i).TopIndex = tind
Next
kayitseti.MoveLast
kayitoku
Dim a
a = Text11.Text
ind = List1(0).ListIndex + 1
f = a - ind
Text10.Text = f
For i = 1 To f
kayitseti.MovePrevious
Next
kayitoku
End Sub


FORM2 ye yazılacaklar

Private Sub Command1_Click()
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Then
MsgBox "Lutfen Urun Bilgilerini Tam Giriniz", vbExclamation, "Ekle"
Exit Sub
Else
Form1.degistir
End If
End Sub
__________________