ناصر سعيد

ابن السطرالذي تم تغييره لو سمحت اخي المحترم Option Explicit ' اسماء المواد Const nTEST As String = "عربي" & "," & _ "رياضيات" & "," & _ "علوم" & "," & _ "دراسات" & "," & _ "انجليزي" & "," & _ "مجموع" & "," & _ "دين" '-------------------------------------- ' ارقام اعمدة الدرجة الاصلية ' بالتسلسل حسب اسماء المواد Const ColmnTotal As String = "20,29,40,49,58,59,85" ' ارقام اعمدة الفصل الثاني ' هنا المجموع ليس له عمود جعلناه صفراً Const ColmnTest2 As String = "17,26,87,46,55,0,82" ' رقم صف النهاية الصغرى Const iRs As Integer = 8 Sub kh_Tgrba() Application.ScreenUpdating = False ActiveSheet.Unprotect Range("CY9:CZ1000").ClearContents Dim r As Integer, tst As String, X As Long X = Application.WorksheetFunction.Max(Range("C:C")) + 8 For r = 9 To X tst = kh_test(r) If Len(tst) Then Cells(r, 103) = "دور ثاني" Else Cells(r, 103) = " ناجح" Cells(r, 104) = kh_test(r) If Cells(r, 103) = " ناجح" Then Cells(r, 104) = "منقول للصف التالي" Next Application.ScreenUpdating = True End Sub Function kh_test(iRow As Integer) As String Dim vT, sT Dim NN As String, TT As String Dim ctlt As Integer, ctst As Integer Dim c As Integer, cc As Integer Dim ib As Boolean cc = UBound(Split(nTEST, ",")) For c = 0 To cc ib = False NN = Split(nTEST, ",")(c) ctlt = Split(ColmnTotal, ",")(c) ctst = Split(ColmnTest2, ",")(c) vT = Cells(iRow, ctlt) If Not IsEmpty(vT) Then Select Case vT Case Is = "غ": ib = True Case Is < Cells(iRs, ctlt): ib = True End Select End If If ctst = 0 Then GoTo 1 sT = Cells(iRow, ctst) If Not IsEmpty(sT) Then Select Case sT Case Is = "غ": ib = True Case Is < Cells(iRs, ctst): ib = True End Select End If 1: If ib Then TT = TT & NN & " - " Next If Right(TT, 3) = " - " Then kh_test = Left(TT, Len(TT) - 3) Else kh_test = TT ActiveSheet.Protect End Function

جزاك الله خيرا وادعو الله لك بالخير اريد ان تساعدني في الرابط لانه بالانجليزيه

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

جزاك الله كل خير

جزاكم الله خيرا وبارك لكم

جزاكم الله خيرا وبارك لكم

جزاك الله خيرا وبارك لك

رد استاذ شعبان عطيه تحيه طيبة وبعد معنى اساسى 1/9/2012 هو الأساسى الذى تحسب عليه المكافأة وليس 1/7/2012 وذلك حتى يستفيد الذين حصلوا على الدرجه بعد 1/7/12 من دخول العلاوه الى الاساسى الذى تحسب عليه المكافأه وهنا زملاء حصلوا على الدرجة فى 1/9/2012 لهم اضافة علاوة الدرجة الى الأساسى أما من حصلوا على الدرجة بعد 1/9/2012 فتحسب لهم المكافأه على أساسى 1/7/2012 كالزملاء الحاصلين على الدرجة فى 1/11/2012 وهذاهوخطاب وزير الماليه 400469_471774582907261_386191142_n (1).jpg‏ (89.2 كيلوبايت

بارك الله فيك أخى الكريم ابو حنين

افضل موقع للرفع هو مركز الخليج يارك الله لكم

العلامه عبد الله الاضافه التي اضفتها في محلها تمام هل يمكن ان تظهر بطريقه اخرى غبر المستطيلات سطر واحد فيه كشف أوائل الطلبه على مستوى المدرسه كشف أوائل الطلبه في ماده ...... على مستوى ( المدرسه أو فصل ... ) ولك جزيل الشكر

لاأجد من الكلمات غير جزاك الله خيرا

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

العلامة الكبير جزاك الله خيرا الكود راااااااااااااااااااااااااااااااااااائع بعد عدة تجارب ظهرت هذه الصوره مامعناها ؟

العلامة الكبير عبد الله جزاك الله خيرا وأعانك على فعل الخير

ربنا يرزقنا بأحد الأفذاذ

اولا اشكركم كثيرا بارك الله لكم الكود رائع ولكنه لايؤدي المطلوب ... لماذا ؟ لأننا نريد أن يتم احنساب الأوائل على اساس المجموع فإن تم التساوي يكون بالأصغر سنا وإن تساووا فبالترتيب الهجائي الكود الرائع الذي يؤدي الغرض هو كود الاستاذ القدير عبد الله باقشير ولكنه لايأتي بالعشر مراكز الأولى وليس العشر طلاب

كرما منك ضع ملفا بارك الله فيك

للرفع

وهذا هو كود الفرز Sub Macro1() ' Range("BB6:BE191").Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range( _ "BC6:BC191"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ xlSortNormal ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range( _ "BD6:BD191"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range( _ "BB6:BB191"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("Sheet1").Sort .SetRange Range("BB5:BE191") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("BB6").Select End Sub

Function OrdinalNum(ByVal Num As Variant, Optional ByVal Sex As Byte = 0) As String Const Male = 0 Const Female = 1 Dim Sings(1 To 11) As String Dim Tens(2 To 10) As String Dim Fem As String On Error Resume Next OrdinalNum = Num Num = CDbl(Num) If Num < 1 Or Num > 100 Or Num <> CLng(Num) Then Exit Function End If Sings(1) = "الأول" Sings(2) = "الثاني" Sings(3) = "الثالث" Sings(4) = "الرابع" Sings(5) = "الخامس" Sings(6) = "السادس" Sings(7) = "السابع" Sings(8) = "الثامن" Sings(9) = "التاسع" Sings(10) = "العاشر" Sings(11) = "الحادي" Tens(2) = "العشرون" Tens(3) = "الثلاثون" Tens(4) = "الأربعون" Tens(5) = "الخمسون" Tens(6) = "الستون" Tens(7) = "السبعون" Tens(8) = "الثمانون" Tens(9) = "التسعون" Tens(10) = "المائة" If Sex > Female Then Sex = Male Fem = IIf(Sex = 0, "", "ة") Select Case Num Case 1: OrdinalNum = Sings(Num) & IIf(Sex = Male, "", "ى") Case 2 To 10: OrdinalNum = Sings(Num) & Fem Case 11: OrdinalNum = Sings(Num) & Fem & " عشر" & Fem Case 12 To 19: OrdinalNum = Sings(Num Mod 10) & Fem & " عشر" & Fem Case Else Select Case Num Mod 10 Case 0: OrdinalNum = Tens(CLng(Num / 10)) Case 1: OrdinalNum = Sings(11) & Fem & " و" & Tens(Fix(Num / 10)) Case Else: OrdinalNum = Sings(Num Mod 10) & Fem & " و" & Tens(Fix(Num / 10)) End Select End Select End Function هذا هو الكود المطلوب التغيير فيه

هذا الملف به مرفق والمرفق به كود لذكر الاول والاول مكرر وهكذا ارجو طهور بعد الاول والاول مكررإن وجد الثاني وليس الثالث على سبيل المثال في المرفق المفروض يطهر بدل العاشر الثاني ولكم الشكر والمرفق يوضح اكثر اوائل.rar

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

شكرا لكم

حزاكم الله خيرا