كل الانشطه

اسمحوا لي بمداخلة صغيرة . أخي الريم عند اضافة أكواد إلى مشاركتك أو أي موضوع لك لاحقاً ، حاول استخدام إشارى <> المخصصة لكتابة أو لصق الأكواد فيه . أما بخصوص هذه المشكلة عند المسميات العربية والتي لا ننصح بها دائماً في برمجة VBA هي :- لاحظ الرموز التي نتجت عند نسخك للكود في الوقت الذي كانت فيه لغة الكيبورد = English في كمبيوترك !! بينما لاحقاً ومستقبلاً عند نسخ أي كود من محرر الأكواد وكان الكود يحتوي مسميات عربية ، حاول تغيير لغة الكتابة الى العربية قبل النسخ واللصق . كل الإحترام والتقدير للأساتذة وخبراء ومعلمي قسم الآكسل . فلا أتعدى ولا أنقص من مجهودكم بقدر ما لفت انتباهي تكرار هذه النقطة عند الكثيرين من الأخوة أصحاب الطلبات بما يخص هذه المشكلة CE??EC??E .

وعليكم السلام ورحمة الله وبركاته .. من خلال المعطيات التي ذكرتها .. الوزن الصافي (طن) : مثلاً 197 طن درجات القمح : درجة 23.5 بسعر 2200 جنيه درجة 23.0 بسعر 2150 جنيه درجة 22.5 بسعر 2100 جنيه الخصومات : دمغة : 1 جنيه النقابة : 0.55 جنيه لكل أردب ستكون المعادلة في اكسل افتراضاً بالشكل التالي :- = (الوزن_الصافي * 1000 / 150) * (IF(الدرجة>=23.5, 2200, IF(الدرجة>=23, 2150, IF(الدرجة>=22.5, 2100, 0))) - (دمغة + (الوزن_الصافي * 1000 / 150 * 0.55))) وكفكرة على كيفية تطبيقها : قم بإعداد جدول بهذه الأعمدة ( أسماء الأعمدة في الصف الأول ) :- A : رقم الكرتونة B : الوزن الصافي (طن) C : درجة القمح D : السعر E : الخصومات F : الصافي في الخلية D2 (السعر) = المعادلة التالية :- =IF(C2>=23.5, 2200, IF(C2>=23, 2150, IF(C2>=22.5, 2100, 0))) في الخلية E2 (الخصومات) = المعادلة التالية أيضاً :- =1 + (B2*1000/150*0.55) -في الخلية F2 (الصافي) = المعادلة : =(B2*1000/150*D2)-E2 طبعاً على افتراض أن الأردب = 150 كيلو جرام حسب النظام المصري .

وعليكم السلام ورحمة الله وبركاته .. أقصى سعة تخزين في آكسيس = 2 جيجابايت تقريباً لكل ملف .

ما هى قدره التخزين على قاعده بيانات الاكسيس بالجيجا؟ يعنى نقدر نسجل ونحفظ سجلات وبيانات لغايه كام جيجا؟؟

السلام عليكم ورحمة الله ووبركاته ممكن معادله لحساب تسويق القمح 2025 مع معطيات كرته قمح فيها الوزن الصافى مثلاً ك ط 1 197 والدرجات وهى درجة 23.5 ب 2200 درجة 23.0 ب 2150 درجة 22.5 ب 2100 والخصومات تتجمع مع بعض دمغة 1 النقابة = الاردب فى 0.55

لا استاذ فما برامج بالاكسس تعمل مثل المرفق وتمت تجربتها يمكن بحكم انها صغيرة الحجم CNA-2.rar

اذا كانت بعض البرامج تعمل ، والبعض الاخر لا يعمل (يحذف الكود) ، فيجب النظر في الى الموضوع بعمق اكثر ، اما اذا كانت جميع البرامج لا تعمل ، سواء بحذف الالكسس للكود او اعطاء اخطاء اخرى ، فعندها المذنب يكون الاكسس/الاوفيس ، فيا تعمل للاكسس/الاوفيس اصلاح (باعادة تنصيب البرنامج ، ثم اختيار اصلاح (قد لا يكون هذا الاسم الصحيح ، فاسمه بالانجليزي Repair) ، او اعادة تنصيب الاكسس/الاوفيس كاملا

نفس المشكلة استاذ ونفس الميساجات"يتعذر فتح قاعدة البيانات لأنه لايمكن قراءة مشروع VBA الموجود بها........... الخ " نظن فما مشكلة في الجهاز

شكرا لحضرتك بافندم بس ممكن توضيح أكثر بتعديل الاكواد الموجوده هنا Sub CE??EC??E() ' ' CE??EC??E Macro ' Macro recorded 26/11/2017 by Ahmed Mohsen ' ' Selection.AutoFilter Field:=1, Criteria1:="=CE??EC??E", Operator:=xlOr, _ Criteria2:="=C?C??C??" Range("B5").Select ActiveCell.FormulaR1C1 = "CE??EUUUUUC??E" Range("A3").Select End Sub Sub C?????() ' ' C????? Macro ' Macro recorded 26/11/2017 by Ahmed Mohsen ' ' Selection.AutoFilter Field:=1, Criteria1:="=C?????", Operator:=xlOr, _ Criteria2:="=C?C??C??" Range("B5").Select ActiveCell.FormulaR1C1 = "C???U?UUUUUUUUU?" Range("A3").Select End Sub Sub E????UC?U?E?E() ' ' E????UC?U?E?E Macro ' Macro recorded 26/11/2017 by Ahmed Mohsen ' ' Selection.AutoFilter Field:=1, Criteria1:="=E???? C?U?E?E", Operator:= _ xlOr, Criteria2:="=C?C??C??" Range("B5").Select ActiveCell.FormulaR1C1 = "E???? C?U?E?E" Range("A3").Select End Sub Sub E????UC?O???E() ' ' E????UC?O???E Macro ' Macro recorded 26/11/2017 by Ahmed Mohsen ' ' Selection.AutoFilter Field:=1, Criteria1:="=E???? C?O???E", Operator:= _ xlOr, Criteria2:="=C?C??C??" Range("B5").Select ActiveCell.FormulaR1C1 = "E???? C?O???E" Range("A3").Select End Sub Sub C?????() ' ' C????? Macro ' Macro recorded 26/11/2017 by Ahmed Mohsen ' ' Selection.AutoFilter Field:=1, Criteria1:="=C?????", Operator:=xlOr, _ Criteria2:="=C?C??C??" Range("B5").Select ActiveCell.FormulaR1C1 = "C??UUUUUUUU???" Range("A3").Select End Sub Sub C??OE??E() ' ' C??OE??E Macro ' Macro recorded 26/11/2017 by Ahmed Mohsen ' ' Selection.AutoFilter Field:=1, Criteria1:="=C??OE??E", Operator:=xlOr, _ Criteria2:="=C?C??C??" Range("B5").Select ActiveCell.FormulaR1C1 = "C??OE??E" Range("A3").Select End Sub Sub C?E????() ' ' C?E???? Macro ' Macro recorded 26/11/2017 by Ahmed Mohsen ' ' Selection.AutoFilter Field:=1, Criteria1:="=C?E????", Operator:=xlOr, _ Criteria2:="=C?C??C??" Range("B5").Select ActiveCell.FormulaR1C1 = "C?E????" Range("A3").Select End Sub Sub C????() ' ' C???? Macro ' Macro recorded 26/11/2017 by Ahmed Mohsen ' ' Selection.AutoFilter Field:=1, Criteria1:="=C????", Operator:=xlOr, _ Criteria2:="=C?C??C??" Range("B5").Select ActiveCell.FormulaR1C1 = "C????" Range("A3").Select End Sub

جزاكم الله خير الجزاء وكتب أجركم وجعل دعاءكم في ميزان حسناتكم أسأل الله أن يردها إليكم أضعافا من الخير وأن لا يريكم مكروها في عزيز وأن يحفظكم ومن تحبون من كل سوء

جزاكم الله خيرا وجعله في ميزان حسناتكم

السلام عليكم ورحمة الله و بركاته إضافة بسيطة لسهولة الاستخدام إستمكالا لما بدأه أساتذتي: أ/ هشام و أ/ عبدالله Book111.xlsm

وعليكم السلام ورحمة الله وبركاته .. أخي الكريم أمرك بسيط جداً إن شاء الله ، وهو انك حالياً تقارن بين تاريخ الوفاة وقيمة حقل التاريخ "alyom" في جدول "البيانات" . وهذا غير صحيح للأسف . فالأصل ان تتم المقارنة بين تاريخ الوفاة وتاريخ اليوم = Date في الاستعلام "استعلام بالاسم" وهو مصدر سجلات التقرير "مدة الوفاة" الآن لضبط الأمور كما تريد ، فقط عدل في الاستعلام الحقل الأخير AGE الى التالي :- AGE: diff2dates("ddmmyyyy",[n1],Date(),True) طبعاً انا عملت لك الجزء الخاص فقط اللي في الاستعلام . برنامج الوفيات.accdb

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

وعليكم السلام ورحمة الله وبركاته بعد اذن استاذنا محمد هشام جرب التعديل التالي تفس الكود والتغديل في السطر arr(i - 1) = WS.Cells(i, "I").Value بالسطر arr(i - 1) = CStr(WS.Cells(i, "I").Value) الكود كاملا 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) = CStr(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

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

استاذ @Hazem Hussien ممكن ترسل طلبك بمشاركة جديدة مرفق بها المرفق الذي تريد مع الطلب بأنك تريد ان يعمل على ..... اذكر نوع الويندوس والاوفيس و (64 بت) . وسواء كنت أنا أو أحد الزملاء سيلبي طلبك كما يرى .

اللهم ربّ الناس ، أذهب البأس ، واشفِ أنت الشافي ، لا شفاء إلا شفاؤك ، شفاءً لا يغادر سقمًا . اللهم اشفِ نجل الأخ محمد هشام شفاءً تاماً عاجلاً ، اللهم ألبسه ثوب الصحة والعافية ، وردّه إلى أهله سالماً معافى يا أرحم الراحمين . اللهم اجعل مرضه طهوراً له ، وكفّارةً لذنوبه ، وسبباً لرفع درجته ، وفرّج عن والديه وأهله ، إنك على كل شيء قدير 🤲🏻

هذا لأن الشرط على الحقول الثلاثة في (التنسيق الشرطي) هو DCount("*";"Table1";"[الجنس] = '" & [الجنس] & "' AND [الاسم] = '" & [الاسم] & "' AND [الوظيفة] = '" & [الوظيفة] & "'")>1 فإذا تريد التغيير من ( الاسم ) الى ( Emp_Name) أو تريد التغيير من ( الجنس ) الى ( Emp_Gemder) تريد التغيير من ( الوظيفة ) الى ( Emp_Job) أو الثلاثة معاً غير اسماء الحقول الثلاثة بالفورم والجدول كما سيق فيصبح كما بـــ Report2 بالمرفق التالي . send4-2.rar

يعمل على إصدار أوفيس 2016 64بت ، و ويندوز 10 ( مع إصدار 2010 32بت ) بدون مشاكل

السلام عليكم تم الحل من خلال الغاء السطر الذي يقوم بالغاء التصفية التلقائية If WS.AutoFilterMode Then WS.AutoFilterMode = False وبذلك يتم عمل التعليمات على حسب التصفية الحالية . باقي فقط في حال تطبيق التعليمات اعلاه على عمود فيه ارقام بدل الاسماء فانه لا تتم التصفية هل يوجد حل لو تكرمتم

1) أولا يسعدنا أخي @saad abed أننا إستطعنا مساعدتك 2) نعم إلغاء الرسائل وتحديث الشاشة يسرع الكود بشكل كبير Sub SupApp(ByVal disable As Boolean) With Application If disable Then .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False .Calculation = xlCalculationManual Else .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True .Calculation = xlCalculationAutomatic End If End With End Sub وقد تم تطبيق ذلك في الكود باستخدام SupApp(True) لأنها توقف التحديث البصري للشاشة وتمنع ظهور رسائل التنبيه مثل هل تريد حفظ التغييرات؟ وتوقف الأحداث البرمجية مثل الأكواد المرتبطة بفتح الملفات وكدالك تعطل إعادة الحساب التلقائي للصيغ هذا ما يحسن من سرعة الكود ويقلل من وقت تنفيذ العمليات بشكل ملحوظ خاصة عند معالجة عدد كبير من الملفات

وعليكم السلام ورحمة الله تعالى وبركاته 1) الصور التي أرفقتها توضح أن ملفك يحتوي على روابط خارجية وهي تشير إلى بيانات في ملفات أخرى عند فتح الملف يحاول تحديث هذه الروابط تلقائيا وإذا لم يجد الملفات المرتبطة أو كانت غير متاحة تظهر هذه الرسائل التحذيرية يمكنك استخدام Break Link لكسر الرابط نهائيا لتفادي ظهورها مجددا 2) مجرد اقتراح الأكواد مكررة بشكل كبير يمكن استبدالها بوظيفة واحدة تقبل اسم المنطقة كمتغير بدلا من 36 ماكرو منفصل Sub filtrage(arrName As String, names As String) On Error GoTo ClearApp If ActiveSheet.AutoFilterMode = False Then Range("A1").AutoFilter ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="=" & arrName, Operator:=xlOr, Criteria2:="=الاجمالى" Range("B5").Value = names Range("A3").Select Exit Sub ClearApp: End Sub ثم تستدعيها مثلا بهذا الشكل Sub صندوق_التمويل() Call filtrage("صندوق التمويل", "صندوق التمويل") End Sub جرب هدا بعد كسر الإرتباطات وتنظيم الأكواد مرتبات لسنة 2025.xls

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

تم تعديل الملف ::::::::::::: عدلنا الحقل CorrectionCommittee في الجدول Teachers الى تاريخ/وقت عدلنا الكود تحت الزر بهذا الشكل ........ 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))") availableB = DCount("*", "Teachers", "TeacherCategory = 'B' " & _ "AND (ExamDate Is Null OR ExamDate Not In (SELECT SupervisionDate FROM SupervisionDays))") 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 <> #" & Format(supervisionDate, "mm/dd/yyyy") & "#) " & _ "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 <> #" & Format(supervisionDate, "mm/dd/yyyy") & "#) " & _ "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 تقضل المرفق ....................... ‏‏NA_3.accdb