Foksh

تحقيقاً لرغبة أخي @أحمد العيسى ، إضافة جديدة قريباً للأداة ، إختيار أيقونات مخصصة للأزرار داخل القوائم المختصرة .

استبدل الدالة الكاملة السابقة ، بهذا التعديل :- Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim lastRow As Long Dim cell As Range Dim pctCol As Range Dim pct As Double Dim grade As String Dim i As Long Set ws = Me lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row If lastRow < 2 Then Exit Sub Set pctCol = Intersect(Target, ws.Range("F2:F" & lastRow)) If Not pctCol Is Nothing Then On Error GoTo CleanUp Application.ScreenUpdating = False Application.EnableEvents = False For Each cell In pctCol If IsNumeric(cell.Value) And cell.Value <> "" Then pct = CDbl(cell.Value) Select Case pct Case Is >= 92.1: grade = "ممتاز مع المرتبة" Case Is >= 90.1: grade = "ممتاز" Case Is >= 85.1: grade = "جيد مع مرتبة الشرف" Case Is >= 75.1: grade = "جيد جدا" Case Is >= 65: grade = "جيد" Case Is >= 50: grade = "مقبول" Case Else: grade = "راسب" End Select ws.Cells(cell.Row, "E").Value = grade End If Next cell With ws.Sort .SortFields.Clear .SortFields.Add Key:=ws.Range("F2:F" & lastRow), _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal .SortFields.Add Key:=ws.Range("B2:B" & lastRow), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange ws.Range("A1:M" & lastRow) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .Apply End With For i = 2 To lastRow If ws.Cells(i, "B").Value <> "" Then ws.Cells(i, "A").Value = i - 1 End If Next i CleanUp: Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub الملف بعد التعديل :- لابلبلبلبلبلب.xlsm

مهو انا جاوبتك قبل ما ترد علي بهذه النقطة .. انقل الملف على الكمبيوتر وحدد وانقر Ctrl+T بس لمرة وحدة في حياتك 😅 . وبعدها رجعه على الموبايل .. وجرب 😇 . وعلى فكرة انا ما جربتها ، لكن هي كفكرة خطرت ببالي

ملاحظتك صحيحة أخي وأستاذنا عبدالله ، جزاك الله خيراً على ذكرها . ولكني حين قمت بالتطبيق ارتأيت وبما أنه العمود M هو معادلة مقرونة برقم الصف فلم ألتفت لها ، ولم ألق لها بالاً -رغم تجربتي لها- ولكن لا يضر أن نقوم بالتصويب ..

أهلاً أخي بشااااروو ... انت هنا وهناك 😅 جرب حدد الجدول من الخلية B2 إلى C16 على سبيل المثال .. واضغط Ctrl + T ثم انتر .. وبعدها انقل الملف الى الجوال وستتمكن من الفرز من خلال الأسهم بشكل تلقائي حسبما تريد

وعليكم السلام ورحمة الله وبركاته ، مشاركة مع أخي حجازي ، جرب أن تقوم بتعديل أي نسبة مئوية وراقب الترتيب والفرز هل هو صحيح ومضبوط كما تريد ؟؟ SortBy2Way.xlsm وهذا حل آخر باستخدام ماكرو أكثر وضوح ويدعم معك التراجع على عكس الحل السابق الأول 😅 لابلبلبلبلبلب.xlsm

وااااااااو إبداع وتوظيف جميل وذكي ورائع فوق الخيار للأفكار .. وأنت هنا من أرفع له القبعة أخي منتصر جزاك الله خيراً لصبرك على 7299 سجل في الجدول المخصص للأيقونات . وحقيقة أنت قمت بتوظيف الفكرة التي تقاعست عن تنفيذها في أداة صانع القوائم المختصرة ، ولكن هنا أنت أعدت لي الحماس بالتنفيذ 😜

هل ممكن يكون السبب هو عدم وجود إحتياط كـ Case Else ؟؟

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

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

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

بارك الله فيكم أستاذ جمال ، وشكراً لكم تفاعلكم معنا لتجربتكم 😇

مشاركةً مع اخي منتصر .. استبدل الاستعلام الموجود في الدالة GetLettersArray التي فيها الخطأ ، بالتالي :- strSQL = "SELECT DISTINCT Left(Trim(SearchName), 1) AS SearchLetter " & "FROM (" & strRS & ") AS SubQuery " & "WHERE SearchName IS NOT NULL;" حيث أن الدالة Left تحتاج إلى معاملين . وانت استعملت معامل واحد وهو SearchName ، ولم تحدد رقم الحرف الأول ، لتصبح :- Left(Trim(SearchName), 1)

موضوع مكرر @المشرفين لإجراءاتكم 😇

بارك الله فيك أخي حافظ ، وجزاك الله عنا وعن من سيستفيد من مشروعك هذا كل خير .. ونسأل الله أن يكون في ميزان حسناتك . بعد تحميلي الملف صادفتني مشكلة عند تسجيل الدخول :-

لربما محاولة رفعه مثلاً على جوجل درايف قد تفي بالغرض ، ليكون مرجعاً يستفاد منه عند حاجته .. 🤗

العفو أخي الكريم .. 💐

العفو أخي الكريم 🤗 وإياكم أجمعين 🤲🏻

وعليكم السلام ورحمة الله وبركاته .. لدي ملف قديم أرسله لي أحد الطلاب والأصدقاء ، سأشاركك إياه كتجربة مبدأية قابلة للتطوير . عجلة سؤال وجواب.pptx

شرف لي أن يكوني لي ذكر وأثر في مشاريع أصدقائي وأخواني هنا .. 😇 أما بخصوص مشكلتك فهي نفسها السابقة ذات حقل الترقيم التلقائي . وبالتالي حقل الترقيم التلقائي لا أنصحك باعتماده كحقل رئيسي للترقيم الظاهر . وقد أشرت عليك سابقاً باستخدام الدالة DMAX على سبيل المثال كنمط للترقيم في حقل رقمي ، وهنا لن تتأثر تراقيم وتسلسل سجلاتك . وهناك حلول أخرى متعددة ولكنها ستسبب لك المشاكل مع تضخم السجلات ، ناهيك عن التسبب بخلل في السجلات ذات العلاقة الواحدة والمرتبطة بجداول أخرى ..

شكراً لك على تفاعلك ومشاركتنا النتيجة أخي موسى 🤗 ..

للأسف ، وبشكل واااااضح وملموس .