حمدى الظابط قام بنشر مايو 24, 2018 قام بنشر مايو 24, 2018 السلام عليكم وكل عام وحضرتكم بخير ممكن من لديه فكرة فى شرح الاكواد يشرح لى هذا الكود Option Compare Database Option Explicit Public Function TSFERTABLE() DoCmd.TransferDatabase acExport, "microsoft access", CurrentDb.NAME, acTable, "teacher class", "الجدول" Dim i Dim tb As Recordset Set tb = CurrentDb.OpenRecordset("الجدول", dbOpenDynaset) tb.MoveFirst Do While tb.EOF = False tb.Edit For i = 3 To 100 tb.Fields(i) = " " Next i tb.Update tb.MoveNext Loop End Function Public Function MAKEIT() Call TSFERTABLE Dim mada As Recordset Dim MOALEM As Recordset Dim TABLE As Recordset '_____________________ Set mada = CurrentDb.OpenRecordset("SELECT * FROM [بيانات المادة] ORDER BY [الحصة الاخيرة للمادة] DESC,[الصف]", dbOpenDynaset) Set TABLE = CurrentDb.OpenRecordset("الجدول", dbOpenDynaset) '_____________________ mada.MoveFirst Do While mada.EOF = False Set MOALEM = CurrentDb.OpenRecordset("SELECT * FROM [بيانات المعلم] WHERE [الصف] = " & mada![الصف] & " AND [المادة] =" & "'" & mada![المادة] & "'" & " ORDER BY [الفصل]", dbOpenDynaset) MOALEM.MoveFirst Do While MOALEM.EOF = False TABLE.FindFirst "[رقم]=" & MOALEM![رقم] Call RECORDHSA(MOALEM, mada, TABLE) MOALEM.MoveNext Loop mada.MoveNext Loop Call hlaltath End Function Public Function RECORDHSA(MOALEM As Recordset, mada As Recordset, TABLE As Recordset) Dim i, M Dim TSGELHSA Dim B, E Dim ADDHSSOK As String Dim ADDHSSALWM '___________________________ For M = 1 To mada![عدد الحصص] TSGELHSA = "NO" If M = 1 Or M = 6 Or M = 12 Or M = 17 Or M = 22 Or M = 27 Then B = 3 E = 15 Else B = B + 16 E = E + 16 End If If E > 100 Then B = 3 E = 15 End If Do While TSGELHSA = "NO" ADDHSSALWM = 0 For i = B To E Step 2 ADDHSSALWM = ADDHSSALWM + IIf(TABLE.Fields(i) = " ", 0, 1) Next i If ADDHSSALWM < 5 Then ADDHSSOK = "OK" Else ADDHSSOK = "NO" End If For i = B To E Step 2 If TABLE.Fields(i) = " " And TABLE.Fields(i + 1) = " " And TSGELHSA = "NO" And ADDHSSOK = "OK" Then TABLE.Edit TABLE.Fields(i) = MOALEM![الفصل] TABLE.Fields(i + 1) = MOALEM![المادة] TABLE.Update TSGELHSA = "OK" End If Next i If TSGELHSA = "NO" Then B = B + 16 E = E + 16 If E > 100 Then B = 3 E = 15 End If End If Loop Next M End Function Public Function hlaltath() Dim day_ As Integer Dim B As Integer Dim E As Integer Dim tb As Recordset Dim tbimage As Recordset Dim i As Integer Set tb = CurrentDb.OpenRecordset("الجدول", dbOpenDynaset) B = 3 E = 15 For day_ = 1 To 5 If day_ <> 1 Then B = B + 16 E = E + 16 End If For i = B To E Step 2 tb.MoveFirst Do While tb.EOF = False Set tbimage = CurrentDb.OpenRecordset("الجدول", dbOpenDynaset) tbimage.MoveFirst Do While tbimage.Fields(i) <> tb.Fields(i) Or tbimage.Fields(i + 1) <> tb.Fields(i + 1) If tbimage.Fields(i) = tb.Fields(i) Then Call tbdelhss(tb, tbimage, i, B, E) Exit Do End If tbimage.MoveNext Loop tb.MoveNext Loop Next i Next day_ End Function Public Function tbdelhss(tb As Recordset, tbimage As Recordset, i As Integer, B As Integer, E As Integer) Dim tmpfsl Dim tmpmada Dim amlaltbdel As String Dim II As Integer amlaltbdel = "no" II = i Do While amlaltbdel = "no" And II < 100 II = II + 2 If tb.Fields(II) <> " " Then tmpfsl = tb.Fields(i) tmpmada = tb.Fields(i + 1) tb.Edit tb.Fields(i) = tb.Fields(II) tb.Fields(i + 1) = tb.Fields(II + 1) tb.Fields(II) = tmpfsl tb.Fields(II + 1) = tmpmada tb.Update Set tbimage = CurrentDb.OpenRecordset("الجدول", dbOpenDynaset) tbimage.MoveFirst amlaltbdel = "ok" Do While tbimage.Fields(i) <> tb.Fields(i) Or tbimage.Fields(i + 1) <> tb.Fields(i + 1) If tbimage.Fields(i) = tb.Fields(i) Then amlaltbdel = "no" tb.Edit tb.Fields(II) = tb.Fields(i) tb.Fields(II + 1) = tb.Fields(i + 1) tb.Fields(i) = tmpfsl tb.Fields(i + 1) = tmpmada tb.Update Exit Do End If tbimage.MoveNext Loop tbimage.Close End If Loop If amlaltbdel = "no" Then II = i Do While II < 100 II = II + 2 If Right(tb.Fields(II).NAME, 1) <> "8" Then If tb.Fields(II) = " " Then tmpfsl = tb.Fields(i) tmpmada = tb.Fields(i + 1) tb.Edit tb.Fields(i) = " " tb.Fields(i + 1) = " " tb.Fields(II) = tmpfsl tb.Fields(II + 1) = tmpmada tb.Update Exit Do End If End If Loop End If End Function
خالد عبد الغفار قام بنشر مايو 24, 2018 قام بنشر مايو 24, 2018 صعب حد يترجم الوحدة النمطية بهذا الشكل كان أفضل تنزل الوحدة النمطيه من داخل القاعدة عشان يقدراللى عاوز يساعد يبص على الجداول وما يحتويه كل جدول من حقول خصوصا وانه فيه تداخل بين كلمات كل سطر عشان عربى على انجليزى عموما القصه كلها هنا فى الوحدة النمطية دى هي تبدأ ()Public Function TSFERTABLE هذا الجزء أنا قمت بتعديله فى القاعدة التى أرفقتها بالمشاركة السابقة ألغيت الجدول وجعلته يعمل على جدول تيتشر كلاس فهذا الجزء يقوم بمسح بيانات جدول تيتشر كلاس بيعمل لوب على الحقول من 3 : 100 وانا عدلتهم عشان لغيت يوم السبت وبيمسح بياناتهم وبكده الجدول بيكون فاضى وبالمناسبه لو جيت تضغط على زر التحديث إياه هيمسح البيانات من جدول بيانات المادة ومن جدول بيانات المعلم اسمحللى اشرب قهوتى وبعدين اقولك اللى فهمتو من باقى الوحدة النمطيه
خالد عبد الغفار قام بنشر مايو 24, 2018 قام بنشر مايو 24, 2018 Public Function MAKEIT بعد ان تمت عملية تصفير الجدول ومسح بياناته اعلن عن متغير اسمه الماده Dim mada As Recordset اعلن عن متغير اسمه المعلم Dim MOALEM As Recordset اعلن عن متغير هو جدول تيتشر كلاس Dim TABLE As Recordset هنا كنت احاول اعلن عن متغير اسمه الصف ولكنى لم افلح فى محاولتى Dim sf As Recordset المادة من جدول بيانات المادة المعلم من جدول بيانات المعلم والجدول هو تيتشر كلاس امسك اول ريكورد من الماده اذا وجد فيها قيمه يعنى اسم ماده شوف من جدول بيانات المعلم اذا كان الصف من جدول بيانات المادة يساوى الصف من جدول بيانات المادة والمادة بتساوى المادة من نفس الجدولين من جدول تيتشر كلاس رقم المعلم اللى بيساوى الرقم اللى موجود فى جدول بيانات المعلم ( Call RECORDHSA(MOALEM, mada, TABLE امسك المعلم والمادة ورقم المعلم الموجود فى الجدول اللى هيتم فيه التوزيع وهو تيتشر كلاس ثم المدرس التالى والمادة التاليه عملية الدوران أو اللووب ده اللى قدرت افهمه على قدر معلوماتى الضئيلة بالأكواد ممكن اكون مخطئ وممكن تكوم ضربت معايا كده لذا ممكن احد المشرفين أو الأعضاء يصوب إذا كان هناك خطأ لو وضحت الصوره بالنسبة لك ندخل فى الباقى غلى قدر فهمى كما اسلفت
حمدى الظابط قام بنشر مايو 25, 2018 الكاتب قام بنشر مايو 25, 2018 ارجوا من السادة عباقرة الاكسيس النظر فى ما ذكر من الاستاذ خالد الذى اشكره على مجهودة واجتهادة فى الشرح كما ارجو منك اكتمال الشرح ولك منى كل التقدير لتعاونك
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.