[RaggiTech]

سنبدأ في الأجزاء القادمة في التفصيل ، وسنتعامل الآن مع عملية التعديل .
بحسب نوع العملية ينبغي أن نبحث هل يوجد نوع أو مورد له نفس الاسم قبل الاكمال :

كود :

SQL = "select * from tb_category where name='" & Text1.Text & "'"
Set T4 = D1.OpenRecordset(SQL, dbOpenDynaset)
If T4.RecordCount <> 0 Then
MsgBox "يوجد نوع له نفس الاسم ، فضلاً اختر اسماً آخر", vbExclamation + arabic, "اضافة نوع"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Exit Sub
End If

ونفس الامر بالنسبة للموردين .

الجزء الآخر هو الذهاب إلى هذا السجل عن طريق T2 أو T3 ، ويتم ذلك بالدوران حتى العثور على الرقم الذي قمنا بتخزينه في txt .

كود :

If T2.RecordCount <> 0 Then T2.MoveFirst
For i = 0 To T2.RecordCount - 1
If T2!Number = Val(txt) Then Exit For
T2.MoveNext
Next i

وكذلك وبنفس الطريقة مع الموردين ، وأخيراً أمر التعديل :

كود :

T2.Edit
T2!Name = Text1.Text
T2.Update

وبذلك يصبح الكود الكامل لزر التعديل :

كود :

If List1.ListIndex = -1 Then
MsgBox "عليك اختيار عنصر من القائمة أولاً", vbExclamation + arabic, "تعديل"
Exit Sub
End If

If Text1.Text = "" Then
MsgBox "لا بد من ادخال الاسم الجديد لاستبداله بالاسم القديم !", vbExclamation + arabic, "اضافة بضاعة"
Exit Sub
End If

Dim txt
Dim i
i = 1
Do While (Mid(List1.Text, i, 1)) <> "-"
txt = txt & Mid(List1.Text, i, 1)
i = i + 1
Loop


If lbl_name.Caption = "معلومات الأنواع" Then
'edit category ...
SQL = "select * from tb_category where name='" & Text1.Text & "'"
Set T4 = D1.OpenRecordset(SQL, dbOpenDynaset)
If T4.RecordCount <> 0 Then
MsgBox "يوجد نوع له نفس الاسم ، فضلاً اختر اسماً آخر", vbExclamation + arabic, "اضافة نوع"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Exit Sub
End If

If T2.RecordCount <> 0 Then T2.MoveFirst
For i = 0 To T2.RecordCount - 1
If T2!Number = Val(txt) Then Exit For
T2.MoveNext
Next i

T2.Edit
T2!Name = Text1.Text
T2.Update

Else

'edit factory ...
SQL = "select * from tb_factory where name='" & Text1.Text & "'"
Set T4 = D1.OpenRecordset(SQL, dbOpenDynaset)
If T4.RecordCount <> 0 Then
MsgBox "يوجد مورد له نفس الاسم ، فضلاً اختر اسماً آخر", vbExclamation + arabic, "اضافة مورد"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Exit Sub
End If

If T3.RecordCount <> 0 Then T3.MoveFirst
For i = 0 To T3.RecordCount - 1
If T3!Number = Val(txt) Then Exit For
T3.MoveNext
Next i

T3.Edit
T3!Name = Text1.Text
T3.Update

End If

Refresh_Me
Text1.Text = ""

والآن سنعود لاستئناف عملية الحذف .

كنا قد توقفنا عند استخلاص رقم العنصر المحدد ، والآن سننتقل إليه سواء كان مورداً أم نوعاً ، لكننا لن نقوم بحذفه ، بل سوف نجعل View = False

وأخيراً سوف نتأكد من وجود بضائع تحته وإلا فإننا نحذفه نهائياً .

مبدئياً لا بد من تحذيره قبل عملية الحذف :

كود :

Dim sure
sure = MsgBox("هل أنت متأكد أنك تريد القيام بعملية البحث هذه ؟", vbExclamation + vbYesNo + arabic, "تأكيد الحذف !")
If sure = vbNo Then Exit Sub

وبذلك يصبح الكود الكامل بهذه الطريقة :

كود :

If List1.ListIndex = -1 Then
MsgBox "عليك اختيار عنصر من القائمة أولاً", vbExclamation + arabic, "حذف"
Exit Sub
End If

Dim sure
sure = MsgBox("هل أنت متأكد أنك تريد القيام بعملية الحذف هذه ؟", vbExclamation + vbYesNo + arabic, "تأكيد الحذف !")
If sure = vbNo Then Exit Sub

Dim txt
Dim i
i = 1
Do While (Mid(List1.Text, i, 1)) <> "-"
txt = txt & Mid(List1.Text, i, 1)
i = i + 1
Loop


If lbl_name.Caption = "معلومات الأنواع" Then
'delete category ...

If T2.RecordCount <> 0 Then T2.MoveFirst
For i = 0 To T2.RecordCount - 1
If T2!Number = Val(txt) Then Exit For
T2.MoveNext
Next i

T2.Edit
T2!View = False
T2.Update

SQL = "select count(*) as mycount from tb_product where category=" & Val(txt) & ""
Set T4 = D1.OpenRecordset(SQL, dbOpenDynaset)
If T4!mycount = 0 Then T2.Delete
T4.Close

Else

'delete factory ...

If T3.RecordCount <> 0 Then T3.MoveFirst
For i = 0 To T3.RecordCount - 1
If T3!Number = Val(txt) Then Exit For
T3.MoveNext
Next i

T3.Edit
T3!View = False
T3.Update

SQL = "select count(*) as mycount from tb_product where factory=" & Val(txt) & ""
Set T4 = D1.OpenRecordset(SQL, dbOpenDynaset)
If T4!mycount = 0 Then T3.Delete
T4.Close

End If

Refresh_Me
Text1.Text = ""

وهذا هو ملف البرنامج حتى هذه اللحظة ...
والله الموفق ...
والسلام عليكم ورحمة الله وبركاته .