كل الانشطه

تمام استاذنا / عبدالله بشير جعله الله في ميزان حسناتك وبارك الله فيك

تفضل استاذ @alloui79 المرفق بعد التعديل بطلبك حسب مافهمت بالاستعلام 2 . ووافني بالرد . Database9-2.rar

أخي الفاضل أبو خليل بعد سلام الله عليكم ورحمة الله وبركاته مرسل لحضرتك مرفق وبه تقرير إحصاء بالصفوف الأولي والصف الثالث ولكن صادفتني مشكلة في إحصاء الدين مش عارف أحلها ( موجود بالمرفق جدول الديانة ) أنا أطن لازم نعمل علاقة بين جدول الديانة و الاستعلام qry_Temp بس مش عارف اعمله لو تكرمت انظر للمرفق Data12.rar

السلام عليكم ورحمة الله وبركاته اليك ما طلبت جدول التفريغ22.xlsm

والنعم منك استاذي تقضل الملف مرفق به جدول معلومات المعلمين وبه جدول الخلاصة التي اريدها ان تضهر تلقائي ......... ملاحظات إضافية أحتاج مكان اكتب بها القاعات الامتحانية مثلا لدي 10 قاعات امتحانية وكذلك أحتاج مكان اكتب به ايام المراقبة مثلا من السبت - الأحد - الاثنين- الثلاثاء - الأربعاء - الخميس جدول مراقبة المعلمي.rar

ممتاز أخي @Foksh بارك الله فيك وحزاك كل الخير ان شاء الله

اين بدايتك انت ... جداولك .... حتى نرى ما المطلوب ... ابدأ وسوف تجد الاجابات من مرتادي المنتدى ... ابشر

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا Sub test() Dim dest As Worksheet, WS As Worksheet Dim m As String, a As Variant, k As Variant Dim d As Object: Set d = CreateObject("Scripting.Dictionary") Dim ShArr As Variant: ShArr = Array("aaa", "bbb") Dim i As Long, lr As Long, r As Long: r = 2 With Application .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual On Error Resume Next Set dest = Sheets("التقرير") If dest Is Nothing Then Set dest = Sheets.Add: dest.Name = "التقرير" Else dest.Range("A:E").ClearContents On Error GoTo 0 dest.Range("A1").Resize(1, 5).Value _ = Array("الشهر", "عدد النقلات", "مجموع المبلغ للسائق", "مجموع مبلغ العقد", "مجموع الكمية (طن)") For Each WS In Sheets(ShArr) lr = WS.Cells(WS.Rows.Count, "M").End(xlUp).Row For i = 2 To lr m = Trim(WS.Cells(i, "M").Text) If m <> "" Then If Not d.exists(m) Then d(m) = Array(0, 0, 0, 0) a = d(m) a(0) = a(0) + 1: a(1) = a(1) + tmp(WS.Cells(i, "S").Value) a(2) = a(2) + tmp(WS.Cells(i, "U").Value): a(3) = a(3) + tmp(WS.Cells(i, "F").Value) d(m) = a End If Next i Next WS For Each k In d.Keys a = d(k) dest.Cells(r, 1).Resize(1, 5).Value = Array(k, a(0), a(1), a(2), a(3)) r = r + 1 Next k .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic End With MsgBox "تم إعداد التقرير بنجاح", vbInformation End Sub Private Function tmp(x As Variant) As Double tmp = IIf(IsNumeric(x), x, 0) End Function تقرير من شيتين v2.xlsm

up

المطلوب بالملف سبق طرحه قبل ذلك ولكن كان خاص للمعلمين . واليوم اريد مثلة اوتعديله للفصول Class والكود للاستاذ الفاضل محمد هشام بارك الله فيه جدول التفريغ22.xlsm

Database9-1.accdboool.xlsxاريد ان يكون tva و irtva في نفس السطر في ملف اكسس كما هو مبين في ملف اكسيل ولذلك مجموعهما

السلام عليكم انشاء جدول يتم توزيعه تقائيا بمجرد إدخال المعلومات التالية في برنامج الاكسل جدول بالاعمدة التالية اسم المعلم / القاعة الامتحانية / فئة المعلم / يوم المراقبة/ يوم امتحان مادة المعلم التي يدرسها / لجنة التصحيح وأيضا ان يراعي الشروط التالية الشرط الأول / ان يضع في كل قاعة معلم من فئة a, ومعلم من فئة b في نفس القاعة ونفس اليوم يعني كل قاعة فيها اثنين معلمين الشرط الثاني / اذا كان للمعلم امتحان للمادة التي يدرسها لا يضعه بالمراقبة يعني اذا كان اسم المعلم في عمود ( يوم امتحان مادة المعلم التي يدرسها ) لا يضع بالمراقبة في نفس اليوم الشرط الثالث / اذا كان اسم المعلم موجود في عمود لجنة التصحيح لا يضعه مراقبة

السلام عليكم انشاء جدول يتم توزيعه تقائيا بمجرد إدخال المعلومات التالية في برنامج الاكسس جدول بالاعمدة التالية اسم المعلم /القاعة الامتحانية / فئة المعلم/ يوم المراقبة/ يوم امتحان مادة المعلم التي يدرسها / لجنة التصحيح وأيضا ان يراعي الشروط التالية الشرط الأول / ان يضع في كل قاعة معلم من فئة a, ومعلم من فئة b في نفس القاعة ونفس اليوم يعني كل قاعة فيها اثنين معلمين الشرط الثاني / اذا كان للمعلم امتحان للمادة التي يدرسها لا يضعه بالمراقبة يعني اذا كان اسم المعلم في عمود ( يوم امتحان مادة المعلم التي يدرسها ) لا يضع بالمراقبة في نفس اليوم الشرط الثالث / اذا كان اسم المعلم موجود في عمود لجنة التصحيح لا يضعه مراقبة

السلام عليكم ممكن التعديل على الكود لغرض اعداد تقرير - وكما موضح بالملف المرفق لتكون النتائج من الشيتين aaa bbb او اعداد كود جديد تقرير من شيتين.xlsm

استبدل الدالة القديمة ، بالدالة التالية ، Private Sub AddToTempSelected() On Error GoTo ErrorHandler Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSQL As String Dim anneeValue As Variant Dim gradeValue As Variant Dim wilayaValue As Variant Dim existingWilaya As String Dim wilayaArray As Variant Dim wilayaExists As Boolean Dim i As Integer Dim currentYear As Integer Dim previousYear As Integer Set db = CurrentDb() currentYear = Me.ANNEE3.Column(0) previousYear = currentYear - 1 anneeValue = previousYear & "/" & currentYear gradeValue = Me.GRADE3.Column(0) wilayaValue = Trim(Me.lst_XX.Column(0)) strSQL = "SELECT wilaya FROM temp_selected " & _ "WHERE annee = '" & Replace(anneeValue, "'", "''") & "' " & _ "AND grade = '" & Replace(gradeValue, "'", "''") & "'" Set rs = db.OpenRecordset(strSQL) If Not rs.EOF Then existingWilaya = Nz(rs!wilaya, "") If existingWilaya <> "" Then wilayaArray = Split(existingWilaya, " - ") wilayaExists = False For i = LBound(wilayaArray) To UBound(wilayaArray) If Trim(wilayaArray(i)) = wilayaValue Then wilayaExists = True Exit For End If Next i If Not wilayaExists Then If existingWilaya <> "" Then existingWilaya = existingWilaya & " - " & wilayaValue Else existingWilaya = wilayaValue End If strSQL = "UPDATE temp_selected SET wilaya = '" & Replace(existingWilaya, "'", "''") & "' " & _ "WHERE annee = '" & Replace(anneeValue, "'", "''") & "' " & _ "AND grade = '" & Replace(gradeValue, "'", "''") & "'" db.Execute strSQL, dbFailOnError End If Else strSQL = "UPDATE temp_selected SET wilaya = '" & Replace(wilayaValue, "'", "''") & "' " & _ "WHERE annee = '" & Replace(anneeValue, "'", "''") & "' " & _ "AND grade = '" & Replace(gradeValue, "'", "''") & "'" db.Execute strSQL, dbFailOnError End If Else strSQL = "INSERT INTO temp_selected (annee, grade, wilaya) " & _ "VALUES ('" & Replace(anneeValue, "'", "''") & "', '" & Replace(gradeValue, "'", "''") & "', '" & Replace(wilayaValue, "'", "''") & "')" db.Execute strSQL, dbFailOnError End If CleanUp: If Not rs Is Nothing Then rs.Close Set rs = Nothing Set db = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء محاولة تحديث البيانات", vbCritical + vbMsgBoxRight, "خطأ" Resume CleanUp End Sub حيث سيتم تخزين القيمة في الجدول مباشرة بالتنسيق الذي تريده ( السنة التي تم اختيارها = 2025 ، سيتم تخزينها = 2024 / 2025 في الحقل بعد ان تم تغيير نوعه الى حقل نصي ) BASE_e.accdb

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

Up

جزاك الله خيرا واشكر اهتمام حضرتك

بأقرب فرصة إن شاء الله 😇 .

بأقرب فرصة سنحاول معاً إيجاد حل ، حال وصولي للكمبيوتر 🤗.

انت صاحب الدار .. والمفتاح معك تفضل .. ابدأ بتقريرك هذا

أخي الفاضل بعد التحية والسلام مرفق لسيادتكم ملف ومحتاح عمل تقرير إحصاء باسم ehsa_sfof_ollIa وهذا الإحصاء مطلوب للنتجية كعملية إحصاء تحليلي للنتيجة Data12.rar معلش أنا بتعب حضرتك معاي ولو ممكن تعطني المفتاح وأكمل مع حضرتك ولو فيه حاجة لم تفلح معي أرجع لحضرتك

الحمد لله إنها أمورك كما تريد 😇 قمت بتعديل الإستعلام الأخير ليسهل قراءته بما إنك تعمل على حقول وجداول قد تختلف عن المرفق قليلاً. .

الله يبارك فيك دنيا وآخرة ويدوم عليك الصحة والعافية ويجعله في ميزان حسناتك

اشكر مرورك الكريم اخى الفاضل