كل الانشطه

فيما يلى فى بيئة تشغيل أكسس 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 ايام يتم ملئ الحصص التي قبلها انظر الى الصورة المرفقه

السلام عليكم الجدول يتكون من رقم الكتاب - تاريخ التسجيل - موضوع الكتاب - دار النشر - المؤلف ا ريد جدول المستعيرين وبيناتهم . جدول استعارات اسم المستعير وتاريخ الاستعارة وتاريخ الارجاع ومدة الاستعارة

وعليكم السلام ورحمة الله وبركاته .. على حسب ما فهمت أن المقصود هو أكواد رسم الدوائر كما في ملفك المرفق ، صحيح ؟؟ طيب بدايةً .. وللتوضيح :- إذا كانت الأعمدة تتغير ( ليس دائماً العمود 10 ) ، هنا أخي بلانك يمكنك إضافة معامل رابع للدالة DrawCircles لتحديد آخر عمود ، أو استخدام نطاق أكثر حيوية . لكن بناءً على الأكواد الحالية من ملفك المرفق ، أعتقد أن i = 10 و i >= 2 متغيران ثابتان لجميع الحالات . صحيح ؟؟ إذا كان ما فهمته صحيح .. فاستعمل ما يلي :- الدالة الرئيسية :- Sub DrawCirclesByFoksh(ByVal x As Integer, ByVal startRow As Integer, ByVal endRow As Integer) Dim Shp As Shape Dim i As Long, s As Long, n As Long Dim c As Range If x <= 0 Then Exit Sub i = 10 n = 0 Do While i >= 2 For Each c In Range(Cells(startRow, i), Cells(endRow, 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 c i = i - 1 Loop End Sub ثم تستدعيها من خلال الزر وبتمرير المجموعات التي تريدها ولك الحرية في ذلك ، بهذا النمط :- Sub AddCirclesMain() Call DrawCirclesByFoksh(Range("n9").Value, 10, 14) Call DrawCirclesByFoksh(Range("n17").Value, 18, 22) Call DrawCirclesByFoksh(Range("n25").Value, 26, 30) End Sub طبعاً ستستدعي الدالة AddCirclesMain في زر رسم الدوائر .

استاذ @أحمد الشحات85 اذا كنت لبيت طلبك وكي يستفيد غيرك اضغط تمت الاجابة على أخر مشاركة لي .

وعليكم السلام ورحمة الله وبركاته .. جري استخراج القيم من الخليتين كنص . في أي خلية تريدها استخدم المعادلة التالية :- =TEXT(C3,"yyyy/mm/dd") & " " & TEXT(B3,"yyyy/mm/dd")

حاول تغيير اسم الخط الذي تستخدمه لتنسيق هذا العنصر 🤔

بالتوفيق

السلام عليكم اريد دمج التاريخين في خلية واحدة دمج.xls

up