[RaggiTech]

كاتب الموضوع : أحمد جمال

بسم الله الرحمن الرحيم .
السلام عليكم ورحمة الله وبركاته .

اضافة موردين ( مصانع ) أو أنواع .

بما أن الشاشتان يقومان بنفس المهمة فسنجعلهم جميعاً في شاشة واحدة توفيراً لعدد الشاشات في التصميم ، وسنفرق بينهم حسب محتويات عنوان الشاشة ( اضافة مورد أو اضافة نوع ) وسنضبط المحتوى عند تشغيل الفورم .
كما يمكننا التفريق بينهم من خلال خاصية Tag ولمن لا يعرف هذه الخاصية فهي عبارة عن قيمة للفورم يمكننا التخزين فيها دون أن تظهر للمستخدم ، ويمكننا مثلاً اخبار البرنامج بإنه إذا كانت tag=0 فهذا معناه الشاشة الأولى ، وإلا فهي الثانية مثلاً ، عموماً لن نستخدم هذه الطريقة وسنعتمد على الطريقة الأولى .

لنصمم فورماً صغيراً كل ما يحتوي عليه هو 4 أزرار للاضافة ، حذف الحالي ، تعديل الاسم ، وللانهاء ، كذلك يحتوي على قائمة بالموردين أو الأنواع الحالية ، ومربع نص لنضع به المورد أو النوع الذي نرغب في اضافته .
وأخيراً اسم الفورم Frm_Add_2

كذلك لا تنس أن تغير الاسم في القائمة من ( اضافة مورد جديد - اضافة نوع جديد ) إلى ( التحكم بالموردين - التحكم بالأنواع ) . حيث أن الأمر لن يقتصر على الاضافة بل سيشمل الحذف والتعديل أيضاً .

والآن إلى أمر اظهار هذه الشاشة :

كود :

Case 1
Frm_Add_2.lbl_name = "معلومات الأنواع"
Frm_Add_2.Refresh_Me
Frm_Add_2.Show 1
Case 2
Frm_Add_2.lbl_name = "معلومات الموردين"
Frm_Add_2.Refresh_Me
Frm_Add_2.Show 1

وهذا جزء من الأمر الكلي للقائمة ...

والآن ما هو أمر

Refresh_Me ؟

إنه اجراء Sub لكنه من نوع Public بحيث يمكن مناداته من خارج الفورم ، ووظيفته تكمن في ملء القائمة بالمحتويات المناسبة :

كود :

Public Sub Refresh_Me()
List1.Clear
If lbl_name.Caption = "معلومات الأنواع" Then
If T2.RecordCount <> 0 Then T2.MoveFirst
For i = 0 To T2.RecordCount - 1
List1.AddItem T2!Name
T2.MoveNext
Next i
Else
If T3.RecordCount <> 0 Then T3.MoveFirst
For i = 0 To T3.RecordCount - 1
List1.AddItem T3!Name
T3.MoveNext
Next i
End If
End Sub

لكن وبما أن هذه شاشة متخصصة بعرض الأنواع والموردين ، فلا بد من وضع كلمة بجانب الموردين والأنواع المحذوفة ، لاحظ الكود التالي :

كود :

If T2!View = False Then List1.AddItem T2!Name & " (محذوف)" Else List1.AddItem T2!Name

كما ينبغي أيضاً كتابة رقم النوع أو المورد بجانبه ، ولذا سيكون الكود كالتالي :

كود :

If T2!View = False Then List1.AddItem T2!Number & "-" & T2!Name & " (محذوف)" Else List1.AddItem T2!Number & "-" & T2!Name

والآن إلى كتابة أوامر الأزرار ، مبدئياً لا تنس أمر اغلاق الشاشة :

كود :

Unload Me

ولنر الكود الخاص بعملية الاضافة ... وسيكون النظام بالشكل التالي :

* التأكد أولاً من كتابة اسم في مربع النص .
* التأكد من نوع العملية ( اضافة مورد أم اضافة نوع ) .
* التأكد من عدم وجود مورد أو نوع بنفس الاسم سابقاً .
* اضافة النوع أو المورد الجديد إلى قاعدة البيانات .
* تحديث القائمة عن طريق استدعاء أمر

Refresh_Me ، وافراغ مربع النص .

سنضيف جميع هذه الأوامر في اجراء جديد نسميه MyAdd .

كود :

Sub MyAdd()
If Text1.Text = "" Then
MsgBox "لا بد من ادخال اسم البضاعة !", vbExclamation + arabic, "اضافة بضاعة"
Exit Sub
End If

If lbl_name.Caption = "معلومات الأنواع" Then
'add 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

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

Else

'add 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

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

End If

Refresh_Me
Text1.Text = ""
End Sub

والآن ، قبل البدء بأي عملية حذف أو تعديل لا بد من التأكد أن ثم شيئاً محدداً من القائمة ، ويتم التأكد من ذلك بالشكل التالي :

كود :

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

MsgBox txt

هذا صحيح تماماً ، فهنا ستحتوي txt على الرقم ، ولكن بصورة نصية ، وعند الاستعلام سوف نستعلم عن Val(txt) .
والآن لنضع هذا الكود في عمليتي الحذف والتعديل .

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

يتبع ...

[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 = ""

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