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

جرب هذا الملف الزمن للتعليم المتوسط salim--.xlsm

السلام عليكم ورحمة الله وبركاته اخوتي الكرام ، احببت المشاركة واثراء هذا المنتدى بفكرة وطريقة جديدة لتوزيع الفترات الدراسية على المعلمين خلال اسبوع والفكرة سهلة ويسيرة وقابلة للتطوير والاضافة وتقوم على اعطاء كل حصة رقم معرف فريد يخصها ابتداء من الحصة الأولى لأول يوم حضور وحتى الحصة الأخيرة لآخر يوم دراسي في الاسبوع والعملية تعتمد على جدولين أساسين فقط tblFsl جدول الفصول و tblTechData جدل بيانات المعلم والجدول الثالث tbldivision هو لتوزيع العملية نتيجة العملية استعلامين : 1- جدول الفصول faslTable 2- جدول المعلمين teachersTable ومع المثال يكتفى عن اطالة المقال jadwal.rar

السلام عليكم الله يعافيكم ابي برنامج محاسبة وعملاء على الاكسس اهم شي يكون متفتوح المصدر عشان اعدل عليه او اظيف حقول حتى لو مدفوع القيمة هذا ولكم جل احترامي وتقديري للتواصل 0597272725

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

يعنى حليت المسألة قبل ما نفهمها؟ وفقك الله

اول اشي حقل letter number لازم تعمله بالجدول مطلوب عند التكرار بالنموذج تطلع رسالة خطأ في النوذج -- اجراء حدث عند الخطأ واكتب الكود التالي Private Sub Form_Error(DataErr As Integer, Response As Integer) If DataErr = 3022 Then Response = acDataErrContinue MsgBox "هذه المادة موجودة بالفعل في هذه الفاتورة, يرجى التعديل", vbCritical, "تنبيه" End If End Sub

مشكور على المجهودات المبذولة

ممكن إذا كان قيمة العمود b =1 تتحول إلى 2 وإذا كانت 2 تتحول إلى 1 REPLACE.xlsx

انا افهم ان الذي قلته هو مزاح يا سيدي امزح كما يحلو لك و كيفما يحلو لك و أينما يحلو لك وانا احب المزاح ولا اتضايق منه ابداً

صدقتي يا ياسر الجو ليس معكراً ابداً هناك عشرات المشاركات التي اقدم لها هذه النصيحة (لوجه الله) حتى ان هذه النصيحة صارت محفوظة عندي و اعمل لها Copy Paste والقليل منهم يستجيب (والعجب كل العجب لست انا المستفيد)

انت في قمة الابداع / استاذ سليم تم المطلوب وجزاك الله خيرا

الرفم الذي يظهر هو الفرق بالعلامات يمكن ازالته اذا كنت تريد باستدال هذا السطر من الكود Cells(k + 21, "DV").Offset(, y) = My_St & " : " _ & Abs((My_Rg.Cells(k, 1).Offset(, m).Offset(, 8)) _ - (My_Rg.Cells(k, 1).Offset(, m))) يهذا Cells(k + 21, "DV").Offset(, y) = My_St

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

شكرا والف شكر على مجهودك الكبير جزاك الله خيرا تحية احترام لحضرتكم على اعطاء جزء من وقتكم الثمين لإيجاد الحلول لسؤالنا.. كرمكم تحتار الكلمات لوصفه دعائي لك ان يرزقك الله سبحانه وتعالى السعادة والراحة والسلامة وكل ما تتمناه ... شكرا استاذ سليم حاصبيا سؤالي لماذا تضهر المواد بهذا الشكل ( الانكليزي:12 او العلوم:1 ) هل يمكن ان تكتب المواد فقط انكليزي او علوم

تم التعديل لا حظ (الصفوف من 21 الى 23) الماكرو Option Explicit Sub find_deffrence() Application.ScreenUpdating = False Dim My_Sh As Worksheet: Set My_Sh = Sheets("ورقة1") Dim last_row%: last_row = My_Sh.Cells(Rows.Count, "DD").End(3).Row Dim My_Rg As Range: Set My_Rg = My_Sh.Cells(22, "dd").Resize(last_row - 21, 16) Dim m%: m = 0 Dim col% Dim My_St$ Dim y%, k%: k = 1 My_Sh.Range("DV22:EC" & last_row).ClearContents For k = 1 To My_Rg.Rows.Count For col = 1 To 8 If My_Rg.Cells(k, 1).Offset(, m).Offset(, 8) <> _ My_Rg.Cells(k, 1).Offset(, m) Then y = Application.CountA(Cells(k + 21, "DV").Resize(1, 8)) My_St = My_Rg.Cells(k, 1).Offset(, m).Offset(-k) Cells(k + 21, "DV").Offset(, y) = My_St & " : " _ & Abs((My_Rg.Cells(k, 1).Offset(, m).Offset(, 8)) _ - (My_Rg.Cells(k, 1).Offset(, m))) End If m = m + 1 Next m = 0 Next Application.ScreenUpdating = True End Sub الملف aamir_salim modfier.xlsm

اخي الكريم سؤالك غير واضح تماما اكثر من مرة ادخل اريد المساعدة ثم اخرج ولا اعمل شيئا .. ومؤكد ان بقية الاعضاء مثلي فانت تريد اضافة سجلات ولم توضح ما هي هذه السجلات ومن اين يأتي بها وهل هي سجلات فارغة ام تكرار لسجل موجود بالنسبة لسؤالك الاخير : تقدر تعمل شرط اذا تحقق لا يكرر النسخ اذا اردت المساعدة ارفق عملك الاخير لضبط الشرط

تفضل: Private Sub Hb_GotFocus() Hb = Round((([Pcv] - 2) / 3), 1) End Sub

عذرا لتاخري في الرد بسبب الاطلاع على الملف . واعتذر بالنسبة لدمج الصفوف وان شاء الله لا تتكرر في المرات القادمة منكم نتعلم قمت برفع الملف واختصرت في الملف للتوضيح اكثر ... انا اريد ان يعطي المواد التي اختلفت وتغيرت الدرجة من الجدول الاول عن الجدول الثاني وهي اضافة 5درجات بمعنى اريد الدرجات التي اختلفت من الجدول الاول عن الجدول الثاني مثلاً احمد5 لم تتغير الدرجات الجدول الاول عن درجات الجدول الثاني اي لم يحصل على درجة قرار .... من الملاحظ في الكود والمعادلة تكتب المواد التي درجتها 50 وهذا ليس المطلوب وانما المطلوب هو كتابة المواد التي تغيرت درجتها في الجدول الثاني بالنسبة للجدول الاول وقد قمت بتغير التنسيق الشرطي حتى يكون واضح انه المواد او الدرجات في الجدول الثاني لا تساوي درجات الجدول الاول بمعنى انه احمد1 يكون التغيير في اللغة الانكليزية والعلوم واحمد2 فقط اللغة الانكليزية واحمد3 و احمد4 واحمد5 واحمد6 واحمد7 لاتوجد مواد قرار شكرا جزيلاً لك استاذي الكريم سليم على اجاباتك الرائعة .. عسى ان يكون الشرح واضح ...... وعذرا قد اثقلت عليك بالكلام aamir_salim.xlsm

نفس الملف بالمعادلات هذه المعادلة توضع في الخلية DV24 مع (Ctrl+Shift+Enter) معادلة صفيف و تسحب يساراً 7 أعمدة و نزولاً الى اخر صف فيه بيانات =IF(COLUMNS($DV$24:DV$24)>COUNTIF($DL24:$DS24,50),"",INDEX($DL$21:$DS$21,SMALL(IF($DL24:$DS24=50,COLUMN($DL24:$DS24)-COLUMN($DL24)+1),COLUMNS($DV$24:DV$24)))) الملف مرفق aamir_salim1.xlsm

ريما يكون المطلوب تم التعديل على بنية الجدول لحسن عمل الكود من شروط الاكسل لأي جدول (حدود الجدول يمينا يساراً فوق وتحت يجب ان تكون حلايا فارغة و يمنع دمج الخلايا ضمن الجدول) لذلك اضفت عامود فارغ (العامود DU) في المرة القادمة تجنب دمج الخلايا والاعمدة والصفوف (الصفوف من 21 الى 23) والا سأتوقف عن المساعدة (تضييع وقت في تنسيق الجداول) الكود Option Explicit Sub Give_matiere() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim My_arr() Dim My_col$, x%: x = 24 Dim k%, i%, y% Dim lr%: lr = Range("DD21").CurrentRegion.Rows.Count + 20 My_arr = Array(116, 117, 118, 119, 120, 121, 122, 123) Range("DV24").Resize(lr, 7).ClearContents For k = 0 To UBound(My_arr) For i = x To lr If Cells(i, My_arr(k)) = 50 Then y = Application.CountA(Cells(i, "DV").Resize(1, 7)) Cells(i, "DV").Offset(, y) = Cells(21, My_arr(k)) End If Next Next Erase My_arr With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub الملف مرفق aamir_salim.xlsm

ليس معطوب ولكن تم ضغطه ببرنامج ضغط حديث تفضل الملف بدون ضغط jadwal.mdb