نعاود الشكر لكم في هذا المنتدى واعضاءه و خاصة الاخوة المشرفين لما يقدموه لنا من نصائح و دروس تعليمية لبرامج الاوفيس وكل ما يختص بمجال الحاسب
اخي عبدالرحمن لقد حاولت معي لايجاد حل للمشكلة التي وضعتها ولك مني كل التقدير والعرفان لمساهماتك وخاصة الاخيرة والتي منها استوحيت الفكرة لحل المشكلة التي واجهتني وهي استخدام الكود
اخ عبدالرحمن المشكلة التي كنت اوجهها هي ايجاد مجموع الحيوانات التي تم مراجعتها في الادارة في تاريخ معين والخطأ الذي وقعت فيه (مع احترامي لك) حنى في التعديل انه عند تحديد التاريخ النتائج التي تظهر فقط الحيوانات التي لم يدخل لها اي مراجعة وكانت تاخذ القيمة 0 اما الحيوانات التي قامت بالمراجعتها كانت تاخذ مجموعها .
ولهذا قمت بانشاء جدول جديد واسميته temptab والغرض منه يحفظ القيمة مؤقتا لجميع الحيوانات بعد تنفيذ هذا الكود
Private Sub أمر0_Click()
On Error Resume Next
'تعريف البيانات
Dim strUpdate, strSave, strSQL, strSQL2 As String
Dim rs1, rs2 As DAO.Recordset
Dim db As Database
'التاكد من ادخال البداية التاريخ
If IsNull([Dat_from]) Then
MsgBox "من فضلك أكتب التاريخ الأول", vbExclamation, "التاريخ الأول"
[Dat_from].SetFocus
Exit Sub
End If
'التاكد من ادخال نهاية التاريخ
If IsNull([Dat_to]) Then
MsgBox "من فضلك أكتب التاريخ الثاني", vbExclamation, "التاريخ الثاني"
[Dat_to].SetFocus
Exit Sub
End If
'الاتصال بقاعدة البيانات
Set db = CurrentDb
'اولا تصفير جميع الاعداد في جدول TempTab
strUpdate = " UpDate TempTab set [qu] =0"
DoCmd.SetWarnings False
DoCmd.RunSQL (strUpdate)
' ثانيا الاستعلام الخاص بايجاد عدد الحيوانات التي قامت بمراجعة الادارة
strSQL = "SELECT Q1.EnimalName AS [Enimal_Name], Sum(NZ([Mos_Qu],0)) AS [Enimal_Qu] "
strSQL = strSQL + "FROM Q1 LEFT JOIN HalaDes ON Q1.hala_No = HalaDes.Hala_No "
strSQL = strSQL + "WHERE (((Q1.Hala_Date) Between '" & Me.Dat_from & "' And '" & Me.Dat_to & "')) "
strSQL = strSQL + "GROUP BY Q1.EnimalName"
Set rs1 = db.OpenRecordset(strSQL)
' التاكد من عدد السجلات التي قامت بالمراجعة
If rs1.RecordCount = 0 Then
MsgBox "لايوجد مراجعات حسب التاريخ المدخل ", vbOKOnly, ".تنبيه."
Exit Sub
End If
' ثالثا الاستعلام الخاص بجدول الحيوانات وعددها
strSQL2 = "SELECT enimal, qu FROM TempTab "
Set rs2 = db.OpenRecordset(strSQL2)
rs1.MoveFirst
rs2.MoveFirst
Do While Not rs1.EOF
Do While Not rs2.EOF
If Trim(rs1!Enimal_Name) = Trim(rs2!enimal) Then
rs2.Edit
rs2![qu] = rs1![Enimal_Qu]
rs2.Update
End If
rs2.MoveNext
Loop
rs2.MoveFirst
rs1.MoveNext
Loop
MsgBox " تم حفظ البيانات ", vbExclamation, ".تنبيه."
End Sub
وهذه صورة من العملية بعد تنفيذ البرنامج
ومثلما اشغلتكم بهذه المشكلة احببت ان اشراككم الحل الذي توصلت اليه
