كل الانشطه

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا هل يناسبك Option Explicit Sub FilterByNames() Dim WS As Worksheet, arr(), i&, n&, filterRange As Range Set WS = Sheets("Sheet1") If WS.AutoFilterMode Then WS.AutoFilterMode = False n = WS.Cells(WS.Rows.Count, "I").End(xlUp).Row If n < 2 Then Exit Sub ReDim arr(1 To n - 1) For i = 2 To n arr(i - 1) = WS.Cells(i, "I").Value Next i Set filterRange = WS.Range("B6").CurrentRegion With filterRange .AutoFilter Field:=2, Criteria1:=arr, Operator:=xlFilterValues End With End Sub

مع اني ضد هذا الترتيب المزاجي .. الذي لا يمت للعدل والانصاف بصلة تفضل حسب طلبك : ترتيب العشرة حسب : المجموع ثم العمر ثم الابجدية في الاسم ...................................................................... ملحوظة : استخدام الدالة لاستخراج تاريخ الميلاد في الاستعلام ما ينفعش .. بمعنى لن تتمكن من الترتيب والتصفية الصحيحة لذا عملت حقل لتاريخ الميلاد في جدول الأسماء واعطيته الاسم : BrithDAy ثم شغلت استعلام التحديث الموجود في المرفق باسم QueryBrithDAy يعني سوف تعمل في برنامجك كما عملت انا في هذا المرفق . ............................................................................ Data18.rar

الاخوة الاعضاء عندي جدول مكون من : الرقم - الاسم - العنوان - العمر طبعا لو تم عمل تصفية تلقائية ، سيتم اختيار الاسماء من خلال القائمة المنسدلة وتصفيتها ، ولكن في حال كانت البيانات كثيرة جدا وكنت ارغب مثلا باختيار 10 اسماء من عمود الاسماء الذي يحتوي مثلا 1000 اسم سيكون من الاسهل ان اكتبها في عمود اخر ومن ثم اطلب تصفية عمود الاسماء وفقا لهذا العمود السؤال هل استطيع كتابة العشر اسماء ومن ثم تصفيتها بالفلتر ( طبعا ستظهر فقط الاسماء الموجودة في عمود الاسم ) مرفق مثال عن المطلوب ,,,, مع الشكر لكم ولجهودكم Book111.xlsx

االسلام عليكم .. هل يمكن تظليل السجلات المكررة بتقرير اكسيس بلون مختلف ولكم الشكر send4.zip

هذا البرنامج هو لحساب المواريث والوصايا بالاكسل يمكن تشغيله بالنقال الذكى ..او الحاسوب نسخة 2024 اعداد الفرضى المهندس خالد الطاهر حدادة عنوان البريد الإلكتروني khaledhadada47@gmail.com ليبيا الفرائض_الربانية_بالجداول_الالكترونية_2024.xlsx

السلام عليكم عند محاولة تعديل بيانات ونماذج في اكسس لا استطيع فكيف يمكن تمكين التعديل

تفضل ...... ‏‏NA_2.accdb

على افترض أن لدينا 100 معلم منهم 8 بلجنة التصحيح ولدينا 12 لجنة امتحان ولدينا 8 مواد بــ 8 ايام امتحانات اليكم التوزيع مع مراعاة العدالة في كل شئ ... واصدار تقريران الاول التوزيع حسب كل مادة امتحان كل مادة بصفحة .... والثاني للاحصائيات فقط اذهب لنهايته ستحصل على جدول بالاحصائيات .. ولكم مني كل الاحترام والتقدير . توزيع المراقبين على اللجان.rar

ممكن الملف بدون زحمه على حضرتك وانا جدا ممتن وشاكر لحضرتك على مساعدتك ولطفك العالي وفي ميزان حسناتك ان شاء الله لان اللغة العربية تضهر لي على شكل علامة استفهام في الكود وحاولت لكن ما ضبطت معي

تم تعديل الكود ............................ Dim db As DAO.Database Dim rsA As DAO.Recordset, rsB As DAO.Recordset Dim rsRooms As DAO.Recordset, rsDays As DAO.Recordset, rsTarget As DAO.Recordset Dim supervisionDate As Date, roomName As String Dim teacherAssignedA As Boolean, teacherAssignedB As Boolean Dim dayKey As String Dim safeName As String Dim teacherName As String On Error GoTo ErrorHandler Set db = CurrentDb() ' 1. التهيئة: مسح الجدول وتصفير العدادات db.Execute "UPDATE Teachers SET SupervisionCount = 0" db.Execute "DELETE FROM TeacherAssignment" ' 2. التحقق من توفر عدد كافٍ من المعلمين Dim totalSupervisionsNeeded As Long Dim availableA As Long, availableB As Long Dim daysCount As Long, roomsCount As Long daysCount = DCount("*", "SupervisionDays") roomsCount = DCount("*", "ExamRooms") totalSupervisionsNeeded = daysCount * roomsCount ' معلم A ومعلم B لكل قاعة ' حساب المعلمين المتاحين مع مراعاة جميع شروط الاستثناء availableA = DCount("*", "Teachers", "TeacherCategory = 'A' " & _ "AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays)) " & _ "AND (CorrectionCommittee Is Null OR CorrectionCommittee = '')") availableB = DCount("*", "Teachers", "TeacherCategory = 'B' " & _ "AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays)) " & _ "AND (CorrectionCommittee Is Null OR CorrectionCommittee = '')") If availableA < totalSupervisionsNeeded Or availableB < totalSupervisionsNeeded Then Dim response As VbMsgBoxResult response = MsgBox("تحذير: عدد المعلمين غير كافي!" & vbCrLf & _ "المطلوب: " & totalSupervisionsNeeded & " معلم A و " & totalSupervisionsNeeded & " معلم B" & vbCrLf & _ "المتاح: " & availableA & " معلم A و " & availableB & " معلم B" & vbCrLf & _ "هل تريد المتابعة مع وضع 'غير مغطاة' للقاعات غير المكتملة؟", _ vbYesNo + vbExclamation, "تنبيه") If response = vbNo Then MsgBox "تم إلغاء التوزيع بناءً على طلبك.", vbInformation Exit Sub End If End If ' 3. بدء عملية التوزيع Set rsDays = db.OpenRecordset("SELECT * FROM SupervisionDays ORDER BY SupervisionDate", dbOpenDynaset) Set rsRooms = db.OpenRecordset("SELECT * FROM ExamRooms ORDER BY RoomName", dbOpenDynaset) Set rsTarget = db.OpenRecordset("TeacherAssignment") ' إنشاء قاموس لتتبع المعلمين في كل يوم على حدة Dim dailyTeachers As Object Set dailyTeachers = CreateObject("Scripting.Dictionary") ' حلقة على كل الأيام Do While Not rsDays.EOF supervisionDate = rsDays!supervisionDate ' تهيئة القاموس لهذا اليوم فقط (ليسمح بالتكرار في الأيام الأخرى) dailyTeachers.RemoveAll ' حلقة على كل القاعات rsRooms.MoveFirst Do While Not rsRooms.EOF roomName = rsRooms!roomName teacherAssignedA = False teacherAssignedB = False ' تعيين معلم فئة A Set rsA = db.OpenRecordset("SELECT * FROM Teachers WHERE TeacherCategory='A' " & _ "AND (ExamDate Is Null OR ExamDate <> #" & Format(supervisionDate, "mm/dd/yyyy") & "#) " & _ "AND (CorrectionCommittee Is Null OR CorrectionCommittee = '') " & _ "ORDER BY SupervisionCount ASC", dbOpenDynaset) If Not rsA.EOF Then rsA.MoveFirst Do Until rsA.EOF Or teacherAssignedA teacherName = rsA![teacherName] If Not dailyTeachers.Exists(teacherName) Then ' تعيين المعلم A rsTarget.AddNew rsTarget!teacherName = teacherName rsTarget!TeacherCategory = "A" rsTarget!ExamRoom = roomName rsTarget!supervisionDate = supervisionDate rsTarget.Update ' تحديث العداد safeName = Replace(teacherName, "'", "''") db.Execute "UPDATE Teachers SET SupervisionCount = SupervisionCount + 1 WHERE [TeacherName] = '" & safeName & "'" ' إضافة المعلم للقاموس اليومي فقط dailyTeachers.Add teacherName, 1 teacherAssignedA = True End If rsA.MoveNext Loop End If rsA.Close ' إذا لم يتم تعيين معلم A، تسجيل "غير مغطاة" If Not teacherAssignedA Then rsTarget.AddNew rsTarget!teacherName = "غير مغطاة" rsTarget!TeacherCategory = "A" rsTarget!ExamRoom = roomName rsTarget!supervisionDate = supervisionDate rsTarget.Update End If ' تعيين معلم فئة B Set rsB = db.OpenRecordset("SELECT * FROM Teachers WHERE TeacherCategory='B' " & _ "AND (ExamDate Is Null OR ExamDate <> #" & Format(supervisionDate, "mm/dd/yyyy") & "#) " & _ "AND (CorrectionCommittee Is Null OR CorrectionCommittee = '') " & _ "ORDER BY SupervisionCount ASC", dbOpenDynaset) If Not rsB.EOF Then rsB.MoveFirst Do Until rsB.EOF Or teacherAssignedB teacherName = rsB![teacherName] If Not dailyTeachers.Exists(teacherName) Then ' تعيين المعلم B rsTarget.AddNew rsTarget!teacherName = teacherName rsTarget!TeacherCategory = "B" rsTarget!ExamRoom = roomName rsTarget!supervisionDate = supervisionDate rsTarget.Update ' تحديث العداد safeName = Replace(teacherName, "'", "''") db.Execute "UPDATE Teachers SET SupervisionCount = SupervisionCount + 1 WHERE [TeacherName] = '" & safeName & "'" ' إضافة المعلم للقاموس اليومي فقط dailyTeachers.Add teacherName, 1 teacherAssignedB = True End If rsB.MoveNext Loop End If rsB.Close ' إذا لم يتم تعيين معلم B، تسجيل "غير مغطاة" If Not teacherAssignedB Then rsTarget.AddNew rsTarget!teacherName = "غير مغطاة" rsTarget!TeacherCategory = "B" rsTarget!ExamRoom = roomName rsTarget!supervisionDate = supervisionDate rsTarget.Update End If rsRooms.MoveNext Loop rsDays.MoveNext Loop ' 4. التنظيف وإغلاق الموارد rsTarget.Close rsRooms.Close rsDays.Close Set rsTarget = Nothing Set rsRooms = Nothing Set rsDays = Nothing Set rsA = Nothing Set rsB = Nothing Set db = Nothing Set dailyTeachers = Nothing MsgBox "تم الانتهاء من التوزيع بنجاح!" & vbCrLf & _ "تم تعيين معلم A ومعلم B لكل قاعة" & vbCrLf & _ "مع مراعاة الشروط التالية:" & vbCrLf & _ "- عدم تكرار المعلم في نفس اليوم" & vbCrLf & _ "- السماح بتكرار المعلم في أيام مختلفة" & vbCrLf & _ "- استثناء المعلمين الذين لديهم اختبار في نفس اليوم" & vbCrLf & _ "- استثناء المعلمين في لجان التصحيح" & vbCrLf & _ "- العدالة في التوزيع حسب عدد المراقبات السابقة", _ vbInformation, "إنجاز" Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء التنفيذ: " & vbCrLf & _ "رقم الخطأ: " & Err.Number & vbCrLf & _ "الوصف: " & Err.Description & vbCrLf & _ "في الإجراء: " & Erl, vbCritical, "خطأ" Resume Next اكتب اي عبارة حتى لو رقم المهم الا يكون الحقل فارغ ......

بالفعل عندك حق بالغاء الحماية الكود يعمل الان وسريع شكرا للتوضيح واسف على تعبك وبارك الله فيك

لو سألت لماذا الالوات في موضوعك السابق تعمل وعندما نقلت الكود الى ملفك الاصلي لا تعمل لابد ان هناك شئ تغير في موصوعك السابق في شيت معلمين كود الاستاذ محمد هشام الخاص بالتلوين حماية الشيت غير مفعلة وعتدما تقلت الكود الى الملف الاصلى قمت بتفعيل الحماية فمن الطبيعى ان الكود لا يعمل في وجود حماية وستبقى الالوان قي كل الصفحات منساوية الغ الحماية من شيت معلمين في حدث الورقة وستجد الالوان بالتسبة لسرعة الكود جهازي مواصفاته متوسطة الى جيدة استغرق 6 ثواني لك كل التقدير والاحترام

ههههه معلش حضرتك ننفذ الشروط كما أرسلتها لحضرتك وأنا يهمني في هذا المقام ( الصف الثالث - والرابع - والخامس - والسادس )

توجه التعليم الحديث خاصة الابتدائي اختلف عن زمان ( يسمونها التربية الحديثة) .. يريدونهم سواسية .. لا أوائل .. لا منافسات .. لا فروقات .. يجعلونهم كغنم البربر

لست صاحب الشأن .. وليس لي قرار في هذه المسألة لديي وجهة نظر تخصني لو كنت مسؤولا ماداموا حاصلين على الدرجة نفسها فاالترتيب في الورقة ( العرض) لا بأس حسب ما تفضلت به من شروط اما التقييم فجميع الـــ 21 حاصلون على الترتيب الأول لدي فكرة يمكن ان يحصل تفاوت بينهم وهو لو جعلنا العمل على مجموع المواد كلها

طيب ايه راي حضرتك ( الصح ايه ؟؟ ) دا هو المتبع عندنا

الصف الأول / النصف الأول : يوجد 21 طالبا حاصلون على الدرجة الكبرى 400 كيف تتعامل معهم ؟ كلهم الاول مكرر .. هذا هو العدل يوجد 11 طالب خارج الحسبة اذا اخترت حسب شروطك .. فلذي اسمه يااسر او ياسين او يارا ... الخ نحاسب اهاليهم ليه اختاروا لهم هذه الأسماء حتى تواريخ الميلاد نقص ايام او شهر ، هل تعطي افضلية ؟

الاستاذ /حجازي خاني التعبير المخرج بي دي اف الالوان ثابتة للصفحة الاولى اي لاتتغير وبالتالي معظم المعلمين لا تاخذ الوانهم جرب كده

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

اخي الكريم الكود شغال تمام و أيضا سريع لم يستغرق عندي 5 ثواني لتصدير الملفات جرب تشغلية على كمبيوتر آخر

فك كلمات السر مخالف لقوانين المنتدى. هناك برامج متخصصة و لكنها تحتاج لوقت طويل مثل Passware Kit Forensic ايضا هناك مواقع لذلك ولكنها بمقابل مادي مثل https://www.lostmypass.com/file-types/ms-excel/ https://www.password-find.com

اللهم الشفاءالعاجل ... والسلامة الدائمة ... بحق اسمك الاعظم ونبيك المكرم ...

نعم أخي الكريم يحتسب من المواد الداخلة في المجموع وبالتالي يستبعد الغائب هذه الدالة تستخرج تاريخ الميلاد من الرقم القومي وتوضع في الاستعلام

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

وعليكم السلام ورحمة الله وبركاته .. حيا الله بمهندسنا العود @jjafferr 😃🖐 هذي اللخبطة تحصل لما يكون الكود فيه نص عربي وتجى تنسخه لما يكون مؤشر اللغة على الإنجليزي >>> وهذا عندك مثال للتجربة 🙂 : Function GetFileExt(strPath As String) As String ' ÏÇáÉ ááÍÕæá Úáì ÅãÊÏÇÏ ÇáãáÝÇÊ ãÚ ÇáäÞØÉ Dim strFile As String strFile = Right(strPath, Len(strPath) - InStrRev(strPath, "\")) GetFileExt = Right(strFile, Len(strFile) - InStrRev(strFile, ".") + 1) End Function