أبو العقاب

متابع

مشكور أخ عمر بارك الله بك وسدد خطاك

في المرفق حاولت أن أرتب العشرة الأوائل من خلال ورقة الأوائل الموجودة في عدة ملفات اكسيل المحاولة أخذتها من الأخ عمر الحسيني لكن لم تنفع المحاولة الأوائل في كل شعبة موجودة في ورقة الأوائل ممكن ترتيب العشرة الأوائل ولكم كل احترام ولأن الملف حجمه كبير رفعته من خلال موقع 4shared http://www.4shared.com/rar/v2bmgO2vba/_online.html?

بارك الله فيك اخ عمر

السلام عليكم في المرفق 12 ملف وفي كل ملف شيت العشر الأوائل كيف لي اشتخراج العشر الأوائل على مستوى المدرسة مجلد جديد ‫.rar

طبقت أحد الأكواد ولكنه ينفّذ في الكشف الأدنى ولا ينفذ في الكشف الأعلى لو أحد الأخوة يعدّل لنا الكود الكود هو Sub DrawRedCircles() Dim myArray As Variant Dim Rng As Range Dim Cel As Range Dim Cell As Range Dim L As Long Dim T As Long Dim W As Long Dim H As Long Dim X As Long Dim rRow As Long Dim startRow As Long ãÕÝæÝÉ ÈÃÓãÇÁ ÇáÃÚãÏÉ ÇáãÑÇÏ æÖÚ ÏæÇÆÑ ÍãÑÇÁ ÈåÇ myArray = Array("j", "m", "p", "s", "v", "y", "ab", "ae", "ah", "ak") ÑÞã ÇáÕÝ ÇáÐí íÍÊæí Úáì ÏÑÌÇÊ ÇáäåÇíÉ ÇáÕÛÑì rRow = 17 ÕÝ ÇáÈÏÇíÉ Ãí Ãæá ÕÝ Èå ÏÑÌÇÊ ÇáØáÇÈ startRow = 18 Application.ScreenUpdating = False Call RemoveCircles With Sheets("ÇáßÔÝ") For X = LBound(myArray) To UBound(myArray) Set Cel = Range(myArray(X) & rRow) Set Rng = Range(myArray(X) & startRow, Range(myArray(X) & startRow).End(xlDown)) For Each Cell In Rng If Cell.Value < Cel Or Cell.Value = "Û" Then L = Cell.Left: T = Cell.top W = Cell.Width: H = Cell.Height With ActiveSheet.Shapes.AddShape(msoShapeOval, L, T, W, H) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(255, 0, 0) .Line.Transparency = 0 .Line.Weight = 1.5 End With End If Next Cell Next X End With Application.ScreenUpdating = True ãÕÝæÝÉ ÈÃÓãÇÁ ÇáÃÚãÏÉ ÇáãÑÇÏ æÖÚ ÏæÇÆÑ ÍãÑÇÁ ÈåÇ myArray = Array("j", "m", "p", "s", "v", "y", "ab", "ae", "ah", "ak") ÑÞã ÇáÕÝ ÇáÐí íÍÊæí Úáì ÏÑÌÇÊ ÇáäåÇíÉ ÇáÕÛÑì rRow = 67 ÕÝ ÇáÈÏÇíÉ Ãí Ãæá ÕÝ Èå ÏÑÌÇÊ ÇáØáÇÈ startRow = 68 Application.ScreenUpdating = False Call RemoveCircles With Sheets("ÇáßÔÝ") For X = LBound(myArray) To UBound(myArray) Set Cel = Range(myArray(X) & rRow) Set Rng = Range(myArray(X) & startRow, Range(myArray(X) & startRow).End(xlDown)) For Each Cell In Rng If Cell.Value < Cel Or Cell.Value = "Û" Then L = Cell.Left: T = Cell.top W = Cell.Width: H = Cell.Height With ActiveSheet.Shapes.AddShape(msoShapeOval, L, T, W, H) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(255, 0, 0) .Line.Transparency = 0 .Line.Weight = 1.5 End With End If Next Cell Next X End With Application.ScreenUpdating = True End Sub

??

السلام عليكم في المرفق مثال فيه ورقة الكشف أريد وضع دائرة حمراء حول معدّل المادة الراسبة علما بأن مادة الاجتماعيات النهاية الصغرى 100 وبقية المواد النهاية الصغرى 50 مع مراعاة !!! 1-أنه يوجد كشفين الأول فيه 25 اسم والبقية في كشف آخر أسفل منه 2-إذا كانت الخلية فارغة لا توضع الدائرة الشهادات نهائي مع ترحيل وترتيب الأوائل2016.rar

مشكور أبو عبد الباري حياك الله

السلام عليكم لدي دالة ينتج عنها أحيانا الاشارة #VALUE! الدالة =IF(OR(RANK(AV81;$AV$18:$AV$92;0)=COUNTA($AV$19:$AV$92);RANK(AV81;$AV$18:$AV$92;0)=COUNTA($AV$19:$AV$92)-1);1;"") بحثت فهناك طريقة IFERROR ولكن كيف نطبقها على الدالة

??

شكرا لك على ماقدّمت وننتظر أحد الاخوة الأفاضل

مشكور أخ عبد الله على ما تفضلت به لكن أريد أن تكون الكلمة مكتوبة باللون الأسود وتحتها خط أخمر أي بدل الدائرة خط

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

اساتذتي الكرام لو أردت تطبيق الفكرة على شيت الشهادات1 ما المطلوب تغييره في الكود لأن النهاية الصغرى تكون في عمود وكذلك العلامات وليست في صف

مشكور لك كل تحية لم أنتبه للصف

مشكور أخ عبد الباري بارك الله بك لكن ممكن تعلمني صيد سمكة لماذا اخترنا الرقم 18 في العبارة startRow = 18 مع العلم أن أول عمود فيه بيانات للطلاب هو 8 وليس 18

أخ ياسر بارك الله بك أنا طبقت الكود على المرفق لكن النتيجة كانت الدوائر في غير المكان المطلوب مع أني غيّرت الأرقام ليتناسب مع المثال افتح ورقة الكشف واضغط على وضع الدوائر راح تلاحظ أنها في المكان الخطأ ما طريقة التعديل وبوركتم الشهادات نهائي مع ترحيل وترتيب الأوائل والدوائر.rar

أخ ياسر بارك الله بك وشكرا على مرورك الكريم لدي كود يعمل على وضع الدائرة حول العلامة التي أقل من 50 لأن النهاية الصغرى 50 وأقل منها راسب ولكن هناك أكثر من شرط وهي أن النهاية الصغرى للمواد 50 ولكن في مادة الاجتماعيات النهاية الصغرى 100 أي أن علامة الاجتماعيات من 200 وأقل من 100 توضع الدائرة الحمراء وبالاضافة إلى الشهادات توضع خط أحمر تحت المادة الراسبة وتحت كلمة راسب أظن أن مطلبي يختلف قليلا عن الأمثلة الواردة حيث هناك أكثر من شرط لوضع الدائرة الحمراء أقل من 50 ومادة الاجتماعيات أقل من 100

السلام عليكم في المرفق ورقة اسمها الكشف أريد أن توضع دائرة حمراء حول معدّل المادة التي تقل عن 50 وحول معدّل الاجتماعيات التي تقل عن 100(لأن النهاية الصغرى للاجتماعيات 100 والعظمى 200) وورقة الشهادات أريد أن يوضع خط أحمر تحت النتيجة إذا كانت راسب وتحت معدّل العلامة الراسبة وجزاكم الله كل خير الشهادات نهائي مع ترحيل وترتيب الأوائل.rar

ابو خليل وعبد الله اعذروني نقلت البرنامج على الفلاش فتح النموذج f1 نقلته على الجهاز فتح النموذج f1 أليس المفروض أن لا يفتح على الجهاز فقط أن يفتح على الفلاش وهذا هو المطلوب

عند فتح النموذج frm1 تظهر رسالة أن البرنامج محمي مع أني أدخلت الرقم الصحيح للفلاش

نفس النتيجة السابقة لا تغيير

أستاذنا أبو خليل المشكلة هي هي لم تتغير

بروكتم أخوتي لكن هي فقط النقطة الأخيرة في الموضوع أريده إذا تحقق الشرط إن كان رقم الفلاش 1210253353 يفتح النموذج f1 والا يظهر الرسالة البرنامج محمي الكود عندي هو Option Compare Database Dim i Private Sub Form_Load() If i = "1210253353" Then DoCmd.OpenForm "f1" Exit Sub Else MsgBox "البرنامج محمي" DoCmd.Quit End If End Sub Private Sub Form_Open(Cancel As Integer) strComputer = "." Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") Set colItems = objWMIService.ExecQuery( _ "SELECT * FROM Win32_DiskDrive", , 48) For Each objItem In colItems i = objItem.SerialNumber Next 'mj= i End Sub أين المشكلة في الكود ؟؟ أم أن الرقم غير صحيح مع انه صحيح مئة بالمئة