İsteğe bağlı olarak ürün bilgilerini girebileceğiniz ve kayıt altında tutabileceğiniz bir uygulama.Özellikle veri tabanı konusunda önemli kodlara sahip.
------------------------------
FORM1
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 "Lütfen Ürün Bilgilerini Tam Giriniz", vbExclamation, "Ekle"
Exit Sub
Else
kayitseti.AddNew
kayitseti![Ürün 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![Ürün 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 "Lütfen Aranacak Ürün 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 Ürün Kayıtlarda Yok! Ürün Adını Doğru Girdiğinizden Emin Olun", vbInformation, "Ara"
End Sub
Private Sub Command3_Click()
If List1(0).ListIndex < 0 Then
MsgBox "Silinecek Ürünü Listeden Bulup Seçiniz", 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 Ürünü Listeden Bulup Seçiniz", 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![Ürün 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![Ürün 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![Ürün 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
Private Sub Command1_Click()
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Then
MsgBox "Lütfen Ürün Bilgilerini Tam Giriniz", vbExclamation, "Ekle"
Exit Sub
Else
Form1.degistir
End If
End Sub
------------------------------
FORM1
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 "Lütfen Ürün Bilgilerini Tam Giriniz", vbExclamation, "Ekle"
Exit Sub
Else
kayitseti.AddNew
kayitseti![Ürün 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![Ürün 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 "Lütfen Aranacak Ürün 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 Ürün Kayıtlarda Yok! Ürün Adını Doğru Girdiğinizden Emin Olun", vbInformation, "Ara"
End Sub
Private Sub Command3_Click()
If List1(0).ListIndex < 0 Then
MsgBox "Silinecek Ürünü Listeden Bulup Seçiniz", 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 Ürünü Listeden Bulup Seçiniz", 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![Ürün 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![Ürün 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![Ürün 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
Private Sub Command1_Click()
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Then
MsgBox "Lütfen Ürün Bilgilerini Tam Giriniz", vbExclamation, "Ekle"
Exit Sub
Else
Form1.degistir
End If
End Sub



