ابراهيم الحداد

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

السلام عليكم ورحمة الله استخدم هذه الدالة المعرفة Function Repeat_Int(Rng As Range) For i = 1 To Len(Rng) If IsNumeric(Rng) Then If Mid(Rng, i, 1) = 1 Then p = p + 1 End If End If Next Repeat_Int = p End Function

السلام عليكم ورحمة الله الف مبروك الترقية اخى الكريم وجيه تسحقها عن جدارة و استحقاق ننتظر منك المزيد باذن الله

السلام عليكم ورحمة الله اخى الكريم لقد تم تصميم الشيت على اساس كتابة الغياب فى نفس خلية درجة آخر العام و ليس خلية درجة المجموع و اليك الحل قم باستبدال الداتا فاليداشن او المعروفة بالتحقق من الصحة للتحكم فى الدرجات المدخلة كما يلى حدد عمود آخر العام للمادة ومن التحقق من الصحة اختر Custome ثم اكتب المعادلة التالية فى صندوق Formula مثلا مادة الرياضة العامة : =OR($BA8<=12;$BA8="غ") و فى عمود المجموع ضع المعادلة الآتية ثم اسحب حتى آخر صف وهذه المادلة لمادة الرياضة العامة ايضا : =IF(BA8="غ";"غ";SUM(AY8:BA8)) و يطبق هذا على جميع المواد الاخرى كل فى عموده و بعد ذلك سوف ترى احصيائيات سليمة ومنطقية و الله ولى التوفيق

السلام عليكم ورحمة الله احبتى فى الله اليكم ملف الصف الاول كنترول اولى - ت النهائى 201999.rar

السلام عليكم ورحمة الله اخى الكريم الاهلاوى اشكرك على تنبيهى بالناجحين بالرغم ان لديهم ملاحق فى الدين او التربية الوطنية لذا ارجو من الاخ عمراوى ان ينتبه الى هذا الامر - ارجو المعذرة و بفضل الله قد تم اصلاح الخطأ و كذلك كشف الراسبات اما شيت اولى سوف يتم العمل عليه بعد الافطار باذن الله اليك ملف الصف الثانى حسب آخر التعديلات و يارب النت ميكسفنيش ثانية.xlsm

السلام عليكم ورحمة الله بارك الله فيك اخى الكريم وجيه واشكرك على مرورك العطر اخى الكريم العمراوى تم تعديل الملف بحيث لاتعتبر مادتى التربية الوطنية و الدين مواد رسوب و لكنها مواد ملاحق يعنى الطالب يمكن ان يكون لديه ملاحق فى اللغة العربية و المحاسبة و التربية القومية و الدين ... هذا مافهمته من ردك السابق اليك الملف ثانية.xlsm

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

السلام عليكم ورحمة الله جرب هذا الكود ربما يفيدك ضع كود الصنف الذى تبحث عنه فى الخلية "E1" قبل استخدام الكود Sub Call_Data() Dim Arr As Variant, Temp As Variant Dim LR As Long, i As Long, j As Long, p As Long Dim ws As Worksheet, Kind As Variant Set ws = Sheets("ورقة1") LR = ws.Range("A" & Rows.Count).End(xlUp).Row Kind = ws.Range("E1").Value ws.Range("E3:G" & LR).ClearContents Arr = ws.Range("A5:C" & LR).Value ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) 'On Error Resume Next If Arr(i, 1) = Kind Then p = p + 1 For j = 1 To UBound(Arr, 2) Temp(p, j) = Arr(i, j) Next End If Next If p > 0 Then Range("E3").Resize(p, UBound(Temp, 2)).Value = Temp End Sub

السلام عليكم ورحمة الله كل عام وانتم بخير بمناسبة الشهر الكريم و امتحانات آخر العام اليك الملف بعد التعديل اولى - ت.rar

السلام عليكم ورحمة الله اخى الكريم ناصر كل عام و انتم بخير انا استخدم اوفيس 2016 و الملف فتح عندى بدون مشاكل يؤسفنى عدم القدرة على مساعدتك حقيقة و لا ادرى اين هى المشكلة

السلام عليكم ورحمة الله حقيقة اخى الكريم احمد لم اتعرض من قبل لجلب صور متعددة الامتدادات و لكن سأحاول ان اجرب هذا الامر قريبا ان اشاء الله اما بالنسبة الة السوال الثانى حسب فهمى له سيكون معيار البحث هو اسم الطالب و سيتحدد موضع ادراج الصورة مرتبط بالخلية الموجود بها الاسم و اعتذر ان لم تكن الاجابة مقنعة هذا والله ولى التوفيق

السلام عليكم ورحمة الله استخدم هذه المعادالة و لا تنسى الضغط على Ctrl+Shift+Enter =INDEX(الموقف!$B$2:$F$3;MATCH((E2&D2);الموقف!$B$2:$B$3&الموقف!$D$2:$D$3;0);5)

السلام عليكم ورحمة الله استخدم هذا الكود و قم بتغيير اسم ملف الصور الى Pics و اجعل ملف الاكسل خارج ملف الصور و ليس داخله Sub AddPics() Dim ws As Worksheet, C As Range Dim EmpName As String, T As String, Dpath As String Dim pic As Object Application.ScreenUpdating = False Set ws = Sheets("ورقة1") For Each pic In ws.Pictures pic.Delete Next pic On Error Resume Next Set C = ws.Range("B2:B5") EmpName = ws.Range("A5").Value Dpath = ActiveWorkbook.Path & "\" myDir = Dpath & "Pics" & "\" T = ".jpg" On Error Resume Next ws.Shapes.AddPicture Filename:=myDir & EmpName & T, _ linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=C.Left, _ Top:=C.Top, Width:=C.Width, Height:=C.Height Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله اجعل الكود هكذا Sub Circles1() Dim C As Range Dim MyRng As Range, V As Shape Dim X As Integer, G As Integer, R As Integer, D As Integer '================================================ G = 2 ' عمود رقم الجلوس R = 13 ' صف الدرجات Set MyRng = Range("W14:W1013,AF14:AF1013,AO14:AO1013,BA14:BA1013,BM14:BM1013,BQ14:BQ1013,BU14:BU1013,CF14:CF1013,CO14:CO1013,DA14:DA1013") ' نطاق الخلايا الذي تريد اضافة الدوائر فيها '================================================ X = ActiveWindow.Zoom Application.ScreenUpdating = False ActiveWindow.Zoom = 100 For Each C In MyRng If Cells(C.Row, G) = 0 Then GoTo 1 If C.Value = "" Then GoTo 1 On Error Resume Next If IsNumeric(Cells(R, C.Column)) And Not IsEmpty(Cells(R, C.Column)) And (C.Value < Cells(R, C.Column) _ Or C.Offset(0, -1).Value < Cells(R, C.Column - 1) Or C.Offset(0, -3).Value < Cells(R, C.Column - 3) _ Or C.Offset(0, -3).Value Or C.Offset(0, -3).Value = "" Or C.Value = "غ" Or C.Value = "غـ" Or C.Value = "صفر") Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 2, C.Top + 2, C.Width - 4, C.Height - 4) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.5 D = D + 1 End If 1 Next Set MyRng = Range("BV14:BV1013") ' نطاق الخلايا الذي تريد اضافة الدوائر فيها '================================================ For Each C In MyRng If Cells(C.Row, G) = 0 Then GoTo 2 If C.Value = "" Then GoTo 2 If IsNumeric(Cells(R, C.Column)) And Not IsEmpty(Cells(R, C.Column)) And (C.Value < Cells(R, C.Column) Or C.Offset(0, -1).Value < Cells(R, C.Column - 1) Or C.Offset(0, -2).Value < Cells(R, C.Column - 2) Or C.Value = "غ" Or C.Value = "غـ" Or C.Value = "صفر") Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 2, C.Top + 2, C.Width - 4, C.Height - 4) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.5 D = D + 1 End If 2 Next Set MyRng = Range("AX14:AX1013,bj14:bj1013,CX14:CX1013") ' نطاق الخلايا الذي تريد اضافة الدوائر فيها '================================================ For Each C In MyRng If Cells(C.Row, G) = 0 Then GoTo 3 If C.Value = "" Then GoTo 3 If IsNumeric(Cells(R, C.Column)) And Not IsEmpty(Cells(R, C.Column)) And (C.Value < Cells(R, C.Column) Or C.Value = "غ" Or C.Value = "غـ" Or C.Value = "صفر") Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 2, C.Top + 2, C.Width - 4, C.Height - 4) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.5 D = D + 1 End If 3 Next ActiveWindow.Zoom = X Application.ScreenUpdating = True MsgBox "تم إضافة " & D & " دائرة بنجاح", vbMsgBoxRtlReading, "الحمدلله" End Sub