Foksh

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

⏳ باقي من الوقت : 4 أيام حتى نهاية التحدى الثاني وسيتم إغلاق كتاب التحديات

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

وعليكم السلام ورحمة الله وبركاته .. ارفق ملفك أخي الكريم ، وستجد الحل بإذن الله تعالى

هذه ليست قاعدة بيانات صغيرة 😅 هذه على ما يبدو مشروع كامل 😉

⏳ باقي من الوقت : 6 أيام حتى نهاية التحدى الثاني

أخي الكريم @hanan_ms ، جميلة الأفكار لا شك .. ولكن ما علاقتها في نوع التحدي 😅 .

طيب وقبل طرح الحل ، هل النتيجة في الصورة التالية صحيحة ؟ لاحظ أنني قمت بتعديل تاريخ العطل الصيفية والشتوية من 2022 لتصبح 2025

متابع بصمت

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

هههههههه ، يا عيني عليك ، اكتشفتها بنفسك .. جرب التعديل الأخير على أكثر من احتمال :- 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

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