كل الانشطه

وعليكم السلام ورحمة الله وبركاته ... الأصل أخي @ahmed_dz ، أن توضح طلبك بأكثر مما قمت به .. فمثلاً :- هل تريد الاحتساب ليكون للفترة بين G2-G3 مع استثناء الفترة التي بين C4-F4 ( العطلتين ) . والأمر نفسه للفترة بين H2-H3 !!!! أم ماذا ؟؟؟ يرجى توضيح مطلبك بحرص أكثر حتى تجد إجابة شافية وسريعة .

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

السلام عليكم طلب مساعدة دالة إكسل لحساب عدد ايام العمل ( ملف مرفق ) ولكم مني جزيل الشكر حساب أيام العمل خلال.xlsx

بارك الله فيك أخ حجازي ونفع بعلمك هذا المطلوب

و عليكم السلام ورحمة الله وبركاته استخدم الصيغة =IFERROR(VLOOKUP(G2;بيانات!$S:$T;2;0);"") نقل رقم الهوية_بناء على رقم الطالب (1).xlsx

السلام عليكم اخي الكريم يوجد عندي ملاحظة بالتقرير بعد قيامي بادخال بعض البيانات الجديدة في البرنامج أرجو النظر فيها تحياتي لكم Ahmed ElShahat.rar

أعضاء المنتدى الكرام السلام عليكم ورحمة الله وبركاته أولا أشكركم على ما تقدمونه من جهد في مساعدة الآخرين جعله الله في موازين حسناتكم يوم القيامة ثانيا لدي ملف فيه ورقتين ورقة بيانات وورقة فواتير ورقة البيانات فيها الهوية ورقم الطالب واسمه ورقة الفواتير فيها رقم الطالب واسمه والقاسم المشترك في الورقتين رقم الطالب واسمه المراد إضافة رقم الهوية في ورقة الفواتير تلقائيا بمجرد تشابه رقم الطالب في الورقتين وفق الله الجميع نقل رقم الهوية بناء على رقم الطالب.xlsx

السلام عليكم ومع اني كنت متابع صامتا في الظل ، فحان الوقت للمتابعة صامتا ظاهرا 🙂

فيما يلى فى بيئة تشغيل أكسس 2007 المرفق السابق بعد تحييد كل سطور الخطأ التى ظهرت فيه باستخدام Debug Shift Key Bypass V 2.0.7.rar

بنحاول نتعلم منكم استاذي..... بارك الله فيكم وعليكم وجعلكم الله عونا لأمثالي والاخرين ... تمام الكود كده

تجربة بسيطة حقيقية على ملف ACCDE .😎.

هههههههه ، يا عيني عليك ، اكتشفتها بنفسك .. جرب التعديل الأخير على أكثر من احتمال :- Sub DrawCirclesByFoksh(ByVal x As Integer, ByVal startRow As Integer, ByVal endRow As Integer) Dim Shp As Shape, c As Range Dim r As Long, i As Long, n As Long Dim usedRows As Collection Dim dayCount As Long, perDay As Long, extra As Long Dim rr As Variant, lastCol As Long Dim hasLesson As Boolean Dim lessonCount As Long Dim circlesThisDay As Long If x <= 0 Then Exit Sub Set usedRows = New Collection lessonCount = 0 For r = startRow To endRow hasLesson = False For i = 3 To 10 If Cells(r, i).Value <> "" Then hasLesson = True lessonCount = lessonCount + 1 End If Next i If hasLesson Then usedRows.Add r Next r dayCount = usedRows.Count If dayCount = 0 Then Exit Sub n = 0 If x = lessonCount Then For r = startRow To endRow For i = 10 To 3 Step -1 If Cells(r, i).Value <> "" Then Set c = Cells(r, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 n = n + 1 If n = x Then Exit Sub End If Next i Next r ElseIf x > lessonCount Then Do While n < x For r = startRow To endRow For i = 10 To 3 Step -1 If Cells(r, i).Value <> "" Then Set c = Cells(r, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 n = n + 1 If n = x Then Exit Sub End If Next i Next r Loop Else perDay = x \ dayCount extra = x Mod dayCount If x > 10 And x < lessonCount Then extra = extra + 1 For Each rr In usedRows circlesThisDay = perDay If extra > 0 Then circlesThisDay = circlesThisDay + 1 extra = extra - 1 End If lastCol = 0 For i = 10 To 3 Step -1 If Cells(rr, i).Value <> "" Then lastCol = i Exit For End If Next i For i = lastCol To 3 Step -1 If Cells(rr, i).Value <> "" And circlesThisDay > 0 Then Set c = Cells(rr, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 circlesThisDay = circlesThisDay - 1 n = n + 1 If n = x Then Exit Sub End If Next i Next rr End If End Sub

سلمت اناملك استاذ منتصر جاري التجربة

المرفق تم فيه تحقيق أغلب الأفكار التى أشرت إليها سابقاً ، لكنه يحتاج إلى مزيد من التوافقية لكل الإصدارات بدءاً من أكسس 2007 فى أكسس 2007 واجهة عربية خطأ فى نظام الألوان يمكن اختصاره إلى قليل من الأكواد بأحداث : عند التركيز ، عند فقدان التركيز ، عند النقر ومع تجاهل الخطأ لن يتم باقى وظائف التطبيق كما ترى بخفوت زر تنفيذ فى أكسس 2010 واجهة انجليزية متوافق تماماً فى كل شئ الألوان ، الفلترة ، التمكين ، عدم التمكين ، .... الخ ، ما عدا أنه لم يتعرف على حالة ملف mdb فى أكسس 2024 واجهة عربية متوافق فقط مع ملفات accdb ولم يتوافق مع ملفات mdb الخلاصة المرفق السابق ( أرفقته أسفل ) متوافق مع كل الإصدارات وليس به أى مشاكل وإن كان قليل الميزات بالأحدث ولا يتبقى لى سوى شكري لك على تعبك ومجهودك ، وكفى الله المؤمنين .. وهذه الصور للتطبيق الذى بدون مشاكل له فى أكسس 2007 Enable-Disable Shift Key.accdb

بالفعل تم التجربة ووجدت ما هو في الصورة.... ماالسبب مع ان عدد الحصص 12 حصة والمطلوب وضع عليهم 12 دائرة . لماذا تم ترك واحدة؟؟؟؟؟؟؟؟؟؟؟؟

أنصحك أخي @بلانك ، بتجربة إحتمالات كثيرة على النتيجة والتحقق منها 100% 😉

تمام بارك الله فيك هو ده المطلوب زادك الله علما على علم

علني اكون قد فهمت المنطق جيداً .. تفضل التعديل :- Sub DrawCirclesByFoksh(ByVal x As Integer, ByVal startRow As Integer, ByVal endRow As Integer) Dim Shp As Shape Dim r As Long, i As Long, n As Long Dim c As Range Dim usedRows As Collection Dim dayCount As Long, perDay As Long, extra As Long Dim rr As Variant, lastCol As Long Dim hasLesson As Boolean If x <= 0 Then Exit Sub Set usedRows = New Collection For r = startRow To endRow hasLesson = False For i = 3 To 10 If Cells(r, i).Value <> "" Then hasLesson = True Exit For End If Next i If hasLesson Then usedRows.Add r Next r dayCount = usedRows.Count If dayCount = 0 Then Exit Sub perDay = x \ dayCount extra = x Mod dayCount n = 0 For Each rr In usedRows Dim circlesThisDay As Long circlesThisDay = perDay If extra > 0 Then circlesThisDay = circlesThisDay + 1 extra = extra - 1 End If lastCol = 0 For i = 10 To 3 Step -1 If Cells(rr, i).Value <> "" Then lastCol = i Exit For End If Next i For i = lastCol To 3 Step -1 If Cells(rr, i).Value <> "" And circlesThisDay > 0 Then Set c = Cells(rr, i) Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, _ c.Left, c.Top, c.Width, c.Height) Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 circlesThisDay = circlesThisDay - 1 n = n + 1 If n >= x Then Exit Sub End If Next i Next rr End Sub

تفضل استاذ @بلال بلال الشرح والمرفق حسب ما فهمت . ووافني بالرد . Bilal Mosque.rar

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

جرب المرفق التالى Shift Key Bypass V 2.0.7.accdb.zip

لم افهم بالضبط !!!! يعني النتيجة المطلوبة ، أنه حتى يوم الاربعاء الحصة 2-3 تكون عليها دائرة ؟؟؟ بدلاً من الحصة الخامسة ليوم الإثنين !!!

بدأ يضبط ..............ولكن انظر للصورة المفروض لا يترك اي يوم بدون دائرة قبل ازدواج الدوائر

تمام .. استبدل الدالة الرئيسية بالتالية ، وجربها على ملفك بعد إزالة الدوائر السابقة طبعاً :- Sub DrawCirclesByFoksh(ByVal x As Integer, ByVal startRow As Integer, ByVal endRow As Integer) Dim Shp As Shape Dim i As Long, r As Long, n As Long Dim c As Range If x <= 0 Then Exit Sub i = 10 n = 0 Do While i >= 2 For r = endRow To startRow Step -1 Set c = Cells(r, i) If c.Value <> "" Then Set Shp = Sheet1.Shapes.AddShape(msoShapeOval, _ c.Left, c.Top, c.Width, c.Height) n = n + 1 Shp.Fill.Visible = msoFalse Shp.Line.Weight = 1 Shp.Line.ForeColor.SchemeColor = 10 If n >= x Then Exit Sub End If Next r i = i - 1 Loop End Sub

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