نجوم المشاركات

الآن انت تصارع من اجل ادخال البيانات لا يهم مسألة طريقة الادخال مهما كانت معقدة .. بقدر أهمية التصميم الصحيح للجداول المبرمج الناجح الذي يعمل ويستمتع همه الأكبر صحة التأسيس . لأن خلفها تبعات : استعلامات وتقارير الـ 500 موظف الم يخطر ببالك ادخال تقييمهم جميعا بضغطة زر واحدة ( طبعا حسب فكرتك بوجود قيم افتراضية)؟ ثم بعدها ترجع لمن هو بحاجة الى تعديل ؟

الأخوة أعضاء وزوار هذا الصرح العظيم السلام عليكم ورحمة الله وبركاته اقدم لكم ملف مواقيت الصلاة لعدد 9 مدن من مدن المملكة أتمني ينال إعجابكم مواقيت الصلاة.xlsm

فعلاً ستواجه مشاكل أثناء صراع الأفكار وتنفيذها في نماذجك .. ولكن بناءً على اصرارك ، فقد ارتأتيت تغيير الوجهة كاملة بحيث نجعل العمل من خلال دالة عامة يتم استدعائها في حدث عند التحميل للنماذج ، ودون أن نؤثر على أكوادك في نماذجك .. جرب وأخبرنا بالنتيجة . الصق الدالة التالية في مديول :- Public Sub Foksh(frm As Form) On Error GoTo ErrorHandler Dim rs As DAO.Recordset Dim typ As String Dim ctrl As Control On Error Resume Next Set ctrl = frm.Controls("نص929") If Err.Number <> 0 Then MsgBox "لم يتم التحقق من قيمة وظيفة الموظف", vbExclamation + vbMsgBoxRight, "" Exit Sub End If On Error GoTo ErrorHandler Set rs = frm.RecordsetClone If rs.RecordCount = 0 Then MsgBox "لا توجد سجلات لعرضها", vbInformation + vbMsgBoxRight, "" GoTo CleanUp End If rs.MoveFirst Do While Not rs.EOF typ = ctrl.Value rs.Edit If typ = "مهندسين" Then rs!evalu_moubadara_chaksia = 4.5 rs!evalu_itkan_elamel = 4.5 rs!evalu_nachatat_tarbia = 3 rs!evalu_absence = 8 rs!evalu_retard = 4 rs!evalu_tatwir = 4.5 rs!evalu_absence_prof = 12 rs!evalu_retard_prof = 4 rs!evalu_nadawat_prof = 6 rs!evalu_nachatat_tarbia_prof = 6 rs!evalu_mobadara_prof = 12 Else rs!evalu_moubadara_chaksia = 0 rs!evalu_itkan_elamel = 0 rs!evalu_nachatat_tarbia = 0 rs!evalu_absence = 0 rs!evalu_retard = 0 rs!evalu_tatwir = 0 rs!evalu_absence_prof = 12 rs!evalu_retard_prof = 4 rs!evalu_nadawat_prof = 6 rs!evalu_nachatat_tarbia_prof = 6 rs!evalu_mobadara_prof = 12 End If rs.Update rs.MoveNext Loop frm.Requery CleanUp: On Error Resume Next rs.Close Set rs = Nothing Set ctrl = Nothing Exit Sub ErrorHandler: MsgBox " : حدث خطأ" & Err.Description, vbCritical + vbMsgBoxRight, "خطأ" Resume CleanUp End Sub واستدعيها في حدث عند التحميل في نموذجيك أول أمر :- Private Sub Form_Load() Call Foksh(Me) . . . . . End Sub

أهلا ومرحبا أخي @ابوخليل يسعدني كثيرا مداخلتك ومرورك - شاكرا جدا فضلكم علي وعلى المنتدى الجميل نحن نتعلم منكم و من أمثالكم أساتذنا الكرام وكذا الأعضاء الكرام لو سمحت سأعرض كيفية عمل هذا المشروع وتسعدني مرة أخرى ملاحظاتك هذا العمل خاص بتقييم الموظفين عندي جدولين : الجدول الأول:خاص بالبيانات العامة للموظفين فية : الاسم - الميلاد- النوع- الدرجة وكل شئ.....خاص بالموظف الجدول الثاني: خاص بمعايير التقييم : تقييم الموظفين يتم ادراج بواسطة " زر "البيانات التي احتاجها من الجدول الأول في الجدول الثاني كمثال فقط أنا وضعت هنا نوعين من التقييمات نوع : المهندسين عنده نوع من التقييمات تختلف تماما عن تقييمات نوع المعلمين في الأسماء والنقاط المتحصل عليها لذا وضعت حقول مختلفة حسب معرفتي المتواضعة والله كنت أكتب في كيفية عمل هذا المشروع لأستاذنا @ابوخليلبينما أنت كتب هذا التعليق تفضل أخي @Foksh BASE-E1.accdb

وعليكم السلام ورحمة الله وبركاته بارك الله فيك الملف يعمل بلا اي مشاكل

مرفق الملف بعد التحسين مواقيت الصلاة.xlsm

السلام عليكم فعلا طريقة الملف غير مجدية لأنه اصبح ثقيلاا بفعل المعادلات أخي : الملف مليئ بالمعادلات وكونك الآن لا يمكن ان تحوله إلى الأكواد بسرعة (كونها اخف في الحجم) فقط عملت لك حلا سريعا أرجو أن يناسبك أشتغل على الملف كما كنت تعمل عليه من قبل ولكن الملف الآن لن يحسب لك المطلوب مباشرة فعندما تنهي عملك تماما قم بالحفظ وبعدها سيتم حساب الخلايا في الملف ما قمت به أنا باختصار هو : تحول الحساب التلفائي إلى يدوي ويعمل فقط عند حفظ الملف تفضل تسهيل رصد فورى 1.xlsm

حبيبي وصديقي جو ، انا لم أقم سوى بحذف التسمية التوضيحية للتقرير في آخر مرفق ارسلته لك لا اعلم عن ماذا أو اي جملة شرطية تتحدث . لأنني حقيقة لم أطلع على أي كوووود داخل ملفك سوى الجزء الذي تم التعليق عليه سابقاً !!!

مداخلة وآمل ان يتسع صدر صاحب المسألة لملاحظتي . طريقة التصميم بحاجة الى اعادة نظر جعل كل نوع له حقوله الخاصة غير عملي .. ومخالف لنظام قواعد البيانات ... طريقتك هذه مكانها اكسل

وعليكم السلام ورحمة الله تعالى وبركاته 🤗 كإجابة على السؤال المهم في طلبك ، إن كان يمكن تحقيقه من خلال الجدول نفسه ، فإجابتي لا . ما لم يكن هناك رأي آخر . فمثلاً لا تستطيع ادخال قيمة افتراضية لحقل ما داخل جدول من خلال معادلة أو جملة شرطية . كمثال:- =IIf([loifondamontale]="المهندسين", 1, 0) ولا أحاول إحباطك ، فيمكن تحقيق الهدف بطرق مختلفة . منها استخدام الجمل الشرطية المعقدة داخل حدث بعد التحديث لمربع النص او الكومبوبوكس loifondamontale كمثال للتوضيح بالافتراض ان لديك نموذج لإدخال البيانات في هذا الجدول :- Private Sub loifondamontale_AfterUpdate() Dim typ As String typ = Me.loifondamontale If typ = "مهندسين" Then Me.evalu_moubadara_chaksia = 5 Me.evalu_itkan_elamel = 4 Me.evalu_nachatat_tarbia = 3 Me.evalu_absence = 0 Me.evalu_retard = 1 Me.evalu_tatwir = 2 Me.evalu_absence_prof = 0 Me.evalu_retard_prof = 0 Me.evalu_nadawat_prof = 0 Me.evalu_nachatat_tarbia_prof = 0 Me.evalu_mobadara_prof = 0 ElseIf typ = "معلمين" Then Me.evalu_absence_prof = 1 Me.evalu_retard_prof = 2 Me.evalu_nadawat_prof = 3 Me.evalu_nachatat_tarbia_prof = 4 Me.evalu_mobadara_prof = 5 Me.evalu_moubadara_chaksia = 0 Me.evalu_itkan_elamel = 0 Me.evalu_nachatat_tarbia = 0 Me.evalu_absence = 0 Me.evalu_retard = 0 Me.evalu_tatwir = 0 Else Me.evalu_moubadara_chaksia = 0 Me.evalu_itkan_elamel = 0 Me.evalu_nachatat_tarbia = 0 Me.evalu_absence = 0 Me.evalu_retard = 0 Me.evalu_tatwir = 0 Me.evalu_absence_prof = 0 Me.evalu_retard_prof = 0 Me.evalu_nadawat_prof = 0 Me.evalu_nachatat_tarbia_prof = 0 Me.evalu_mobadara_prof = 0 End If End Sub هذا كإقتراح أول يعتمد على الجملة الشرطية المتعددة ( أو حتى باستخدام Case ) وكلاهما يؤدي الغرض نفسه . أما عن وجود حل آخر وهو استخدام جدول للقيم الإفتراضية التي تريدها ولنفترض انه سيتكون من 3 حقول ( نوع الموظف ، اسم الحقل ، القيمة الإفتراضية ) - أسماء مجازية - وتملأ القيم مرة واحدة ( وقد يكون لها مستقبلاً نموذج لتعديلها حسب رغبتك ) . ثم وبنفس النمط - في حدث بعد التحديث لمربع النص نفسه أو الكومبوبوكس - نستخدم أسلوب كمثال :- Private Sub loifondamontale_AfterUpdate() Dim rs As DAO.Recordset Dim fldName As String, defVal As Variant Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_DefaultValues WHERE نوع_الموظف = '" & Me.loifondamontale & "'") Do While Not rs.EOF fldName = rs!اسم_الحقل defVal = rs!القيمة_الافتراضية Me(fldName) = defVal rs.MoveNext Loop rs.Close Set rs = Nothing End Sub 💡 وفي هذا الحل من الضروري أن تكون أسماء مربعات النص ( في النموذج ) مطابقة تماماً لأسماء الحقول في الجدول . وقد يكون هناك حلول اخرى تعتمد على الاستعلامات تحديث ، ولكنك هنا ستحتاج شرطاً لتحديد السجل الحالي برقم الموظف أو id الحقل ... إلخ. جرب ولن تخسر شيء 😇.

تفضل هذا الملف باجتهاد شخصي مني أملا في أن تكون هناك اضافات و تحسينات من الأساتذة في المنتدى مبيعات ومخازن.xlsx

و عليكم السلام ورحمة الله و بركاته جرب الكود التالي Sub CalculateGenderStats() Dim wsMain As Worksheet Dim wsGender As Worksheet Set wsMain = ThisWorkbook.Sheets("Sheet_Main") Set wsGender = ThisWorkbook.Sheets("Gender Male Female") Dim LastRowMain As Long LastRowMain = wsMain.Cells(wsMain.Rows.count, "A").End(xlUp).Row ' متغيرات للحوالات المصدرة (من العمود I - نوع الراسل) Dim SentMales As Long, SentFemales As Long, SentUnknown As Long Dim SentMalesAmount As Double, SentFemalesAmount As Double, SentUnknownAmount As Double Dim SentMalesClients As Object, SentFemalesClients As Object, SentUnknownClients As Object Set SentMalesClients = CreateObject("Scripting.Dictionary") Set SentFemalesClients = CreateObject("Scripting.Dictionary") Set SentUnknownClients = CreateObject("Scripting.Dictionary") ' متغيرات للحوالات المصروفة (من العمود S - نوع المرسل إليه) Dim PaidMales As Long, PaidFemales As Long, PaidUnknown As Long Dim PaidMalesAmount As Double, PaidFemalesAmount As Double, PaidUnknownAmount As Double Dim PaidMalesClients As Object, PaidFemalesClients As Object, PaidUnknownClients As Object Set PaidMalesClients = CreateObject("Scripting.Dictionary") Set PaidFemalesClients = CreateObject("Scripting.Dictionary") Set PaidUnknownClients = CreateObject("Scripting.Dictionary") Dim i As Long Dim ClientName As String, Gender As String, NationalID As String Dim Amount As Double ' --- تحليل الحوالات المسحوبة (الصادرة) --- For i = 2 To LastRowMain ClientName = Trim(wsMain.Cells(i, "A").Value) NationalID = Trim(wsMain.Cells(i, "B").Value) Gender = Trim(wsMain.Cells(i, "I").Value) Amount = 0 If IsNumeric(wsMain.Cells(i, "F").Value) Then Amount = wsMain.Cells(i, "F").Value ' تجاهل الصفوف الفارغة If ClientName <> "" And NationalID <> "" Then Select Case Gender Case "ذكر" SentMales = SentMales + 1 SentMalesAmount = SentMalesAmount + Amount If Not SentMalesClients.Exists(NationalID) Then SentMalesClients.Add NationalID, 1 Case "أنثى" SentFemales = SentFemales + 1 SentFemalesAmount = SentFemalesAmount + Amount If Not SentFemalesClients.Exists(NationalID) Then SentFemalesClients.Add NationalID, 1 Case Else SentUnknown = SentUnknown + 1 SentUnknownAmount = SentUnknownAmount + Amount If Not SentUnknownClients.Exists(NationalID) Then SentUnknownClients.Add NationalID, 1 End Select End If Next i ' --- تحليل الحوالات المصروفة --- For i = 2 To LastRowMain ClientName = Trim(wsMain.Cells(i, "K").Value) NationalID = Trim(wsMain.Cells(i, "L").Value) Gender = Trim(wsMain.Cells(i, "S").Value) Amount = 0 If IsNumeric(wsMain.Cells(i, "N").Value) Then Amount = wsMain.Cells(i, "N").Value ' تجاهل الصفوف الفارغة If ClientName <> "" And NationalID <> "" Then Select Case Gender Case "ذكر" PaidMales = PaidMales + 1 PaidMalesAmount = PaidMalesAmount + Amount If Not PaidMalesClients.Exists(NationalID) Then PaidMalesClients.Add NationalID, 1 Case "أنثى" PaidFemales = PaidFemales + 1 PaidFemalesAmount = PaidFemalesAmount + Amount If Not PaidFemalesClients.Exists(NationalID) Then PaidFemalesClients.Add NationalID, 1 Case Else PaidUnknown = PaidUnknown + 1 PaidUnknownAmount = PaidUnknownAmount + Amount If Not PaidUnknownClients.Exists(NationalID) Then PaidUnknownClients.Add NationalID, 1 End Select End If Next i ' --- إجماليات --- Dim TotalSent As Long, TotalPaid As Long Dim TotalSentAmount As Double, TotalPaidAmount As Double TotalSent = SentMales + SentFemales + SentUnknown TotalPaid = PaidMales + PaidFemales + PaidUnknown TotalSentAmount = SentMalesAmount + SentFemalesAmount + SentUnknownAmount TotalPaidAmount = PaidMalesAmount + PaidFemalesAmount + PaidUnknownAmount ' --- كتابة النتائج في ورقة Gender Male Female --- ' عناوين الجدول الأول (الحوالات المصدرة) With wsGender .Range("A4:G4").Value = Array("بيان التعاملات", "عدد العمليات", "نسبة العمليات", "عدد عملاء", "نسبة العملاء", "إجمالي المبالغ", "نسبة المبالغ") ' بيانات الذكور (الصادرة) .Range("A5").Value = "ذكر" .Range("B5").Value = SentMales .Range("C5").Value = IIf(TotalSent > 0, SentMales / TotalSent, 0) .Range("D5").Value = SentMalesClients.count .Range("E5").Value = IIf((SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count) > 0, SentMalesClients.count / (SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count), 0) .Range("F5").Value = SentMalesAmount .Range("G5").Value = IIf(TotalSentAmount > 0, SentMalesAmount / TotalSentAmount, 0) ' بيانات الإناث (الصادرة) .Range("A6").Value = "انثي" .Range("B6").Value = SentFemales .Range("C6").Value = IIf(TotalSent > 0, SentFemales / TotalSent, 0) .Range("D6").Value = SentFemalesClients.count .Range("E6").Value = IIf((SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count) > 0, SentFemalesClients.count / (SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count), 0) .Range("F6").Value = SentFemalesAmount .Range("G6").Value = IIf(TotalSentAmount > 0, SentFemalesAmount / TotalSentAmount, 0) ' بيانات غير المحدد (الصادرة) .Range("A7").Value = "غير محدد" .Range("B7").Value = SentUnknown .Range("C7").Value = IIf(TotalSent > 0, SentUnknown / TotalSent, 0) .Range("D7").Value = SentUnknownClients.count .Range("E7").Value = IIf((SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count) > 0, SentUnknownClients.count / (SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count), 0) .Range("F7").Value = SentUnknownAmount .Range("G7").Value = IIf(TotalSentAmount > 0, SentUnknownAmount / TotalSentAmount, 0) ' الإجمالي (الصادرة) .Range("A8").Value = "الاجمالى" .Range("B8").Value = TotalSent .Range("C8").Value = 1 .Range("D8").Value = SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count .Range("E8").Value = 1 .Range("F8").Value = TotalSentAmount .Range("G8").Value = 1 ' عناوين الجدول الثاني (الحوالات المصروفة) .Range("A10:G10").Value = Array("بيان التعاملات", "عدد العمليات", "نسبة العمليات", "عدد عملاء", "نسبة العملاء", "إجمالي المبالغ", "نسبة المبالغ") ' بيانات الذكور (المصروفة) .Range("A11").Value = "ذكر" .Range("B11").Value = PaidMales .Range("C11").Value = IIf(TotalPaid > 0, PaidMales / TotalPaid, 0) .Range("D11").Value = PaidMalesClients.count .Range("E11").Value = IIf((PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count) > 0, PaidMalesClients.count / (PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count), 0) .Range("F11").Value = PaidMalesAmount .Range("G11").Value = IIf(TotalPaidAmount > 0, PaidMalesAmount / TotalPaidAmount, 0) ' بيانات الإناث (المصروفة) .Range("A12").Value = "انثي" .Range("B12").Value = PaidFemales .Range("C12").Value = IIf(TotalPaid > 0, PaidFemales / TotalPaid, 0) .Range("D12").Value = PaidFemalesClients.count .Range("E12").Value = IIf((PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count) > 0, PaidFemalesClients.count / (PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count), 0) .Range("F12").Value = PaidFemalesAmount .Range("G12").Value = IIf(TotalPaidAmount > 0, PaidFemalesAmount / TotalPaidAmount, 0) ' بيانات غير المحدد (المصروفة) .Range("A13").Value = "غير محدد" .Range("B13").Value = PaidUnknown .Range("C13").Value = IIf(TotalPaid > 0, PaidUnknown / TotalPaid, 0) .Range("D13").Value = PaidUnknownClients.count .Range("E13").Value = IIf((PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count) > 0, PaidUnknownClients.count / (PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count), 0) .Range("F13").Value = PaidUnknownAmount .Range("G13").Value = IIf(TotalPaidAmount > 0, PaidUnknownAmount / TotalPaidAmount, 0) ' الإجمالي (المصروفة) .Range("A14").Value = "الاجمالى" .Range("B14").Value = TotalPaid .Range("C14").Value = 1 .Range("D14").Value = PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count .Range("E14").Value = 1 .Range("F14").Value = TotalPaidAmount .Range("G14").Value = 1 ' الإجمالي العام (من B15 إلى G15) .Range("A15").Value = "الإجمالى العام" .Range("B15").Value = TotalSent + TotalPaid .Range("C15").Value = 1 ' النسبة الكلية دائمًا 100% .Range("D15").Value = SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count + PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count .Range("E15").Value = 1 .Range("F15").Value = TotalSentAmount + TotalPaidAmount .Range("G15").Value = 1 End With ' --- تنسيق النسب كنسبة مئوية --- With wsGender .Range("C5:C8, G5:G8").NumberFormat = "0.00%" .Range("C11:C14, G11:G14").NumberFormat = "0.00%" .Range("C15, G15").NumberFormat = "0.00%" .Range("F5:F8, F11:F14, F15").NumberFormat = "#,##0.00" End With MsgBox "تم تحديث تقرير النوع بنجاح!", vbInformation End Sub النسخه النهائيه(2).xlsm

الاخ الفاضل :مصطفى حماد سيد حماد لكي تنفذ طلبك عليك بالتالي اولا الطلبة الناجحين من الصف الثالث تنفذ عليهم استعلام تحديث بيانات و تنقلهم للصف الرابع - أي تجعل الرقم الدال على الصف=4- على سبيل المثال - ( يعني تم تخرجهم لان المرحلة 3 صفوف فقط) ثانيا الطلبة الناجحين من الصف الثاني تنفذ عليهم استعلام تحديث و تجعل الرقم الدال على الصف = 3 ثالثا و أخيرا الطلبة الناجحين من الصف الاول تنفذ عليهم استعلام تحديث لرقم الصف و تجعله = 2 رابعا لا بد من تنفيذ الاستعلامات بالترتيب المشار اليه سابق. خامسا الطلبة الراسبين يبقي في نفس الدرجة و لكن ممكن تغير الحقل الدالة على حالته و تجعله = باقي للاعادة اما الجديد يكون حالته مستجد