اذهب الي المحتوي
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ناصر سعيد

05 عضو ذهبي
  • Content count

    1,754
  • تاريخ الانضمام

  • تاريخ اخر زياره

السمعه بالموقع

232 Excellent

3 متابعين

عن العضو ناصر سعيد

Profile Information

  • Gender (Ar)
    ذكر
  • Job Title
    teacher

اخر الزوار

1,273 زياره للملف الشخصي
  1. بسم الله الرحمن الرحيم من اروع الكنترولات الخاصه بالمدارس نظرا لانه يعتمد على الاكواد القويه السريعه ستجد فيه جميع احتياجاتك من المخرجات لاعمال الكنترول حفظ الله الاستاذ المحترم / عبد الباري البنا كنترول شيت المرحله الابتدائية . بتاريخ 2017/12/10 . تم اجراء التعديلات النهائية كلمه السر 1111 https://up.top4top.net/downloadf-70974rgt1-rar.html ===================== ملف تفعيل الماكرو يدويا للمحترم عبد الباري البنا https://up.top4top.net/downloadf-711gpkup1-rar.html ===== شرح الجزء الاول من البرنامج الرائع https://up.top4top.net/downloadf-711vrswc1-rar.html ===== شرح الجزء الثاني من البرنامج الرائع https://up.top4top.net/downloadf-711ps79t1-rar.html ===== البرنامج الخاص بالمحترم عبد الباري البنا جزاه الله عنا كل خير https://up.top4top.net/downloadf-711j94ex1-rar.html ===== رابط آخر للشيت الورقـي الخاص بالابتدائـي والاعدادي https://up.top4top.net/downloadf-711lyjxn1-rar.html ========== البرنامج منشور على صفحات الفيس للجميع
  2. كود لتصدير كافة الشهادات بصيغة pdf

    اقسم بالله لم استطع تحميله من هذا الرابط السيء وانا اثق ان الاستاذ المحترم ياسر قدم هذا العمل ويبتغي وجه الله ارجو تغيير الرابط
  3. ارجو تعديل الملف

    Sub طباعة() 'هذا الكود خاص بالمحترم بن عليه '(K1) هذه الحليه هي خليه عدد الصفات التي ستطبه 'وهذه هي معادله عدد الصفحات '=ROUNDUP(MAX('مناداة 1'!$A:$A)/10;0) For I = 1 To [K1] If I <= [K1] Then [G1] = I ActiveWindow.SelectedSheets.PrintOut Copies:=1 End If Next [G1] = 1 End Sub جزاك الله كل خير وبارك فيك استاذ بن عليه
  4. ربنا يحفظك ويصونك الاستاذ الخلوق بن عليه وللاستاذ الكبير الخالي تحيه اعزاز واين انت واين فيض علمك جزاكم الله كل خير ربنا يحفظك ويصونك الاستاذ الخلوق بن عليه وللاستاذ الكبير الخالدي تحيه اعزاز واين انت واين فيض علمك جزاكم الله كل خير
  5. النسبة المئوية للذكور والاناث

    =SUMPRODUCT(($F$4:$F$8)*($B$4:$B$8="ذكر"))/COUNTIF($B$4:$B$8;"ذكر") ربنا يبارك فيك الاستاذ المحترم ملك المعادلات بن عليه
  6. بسم الله الرحمن الرحيم احبابي في الله ادعو الله ان تكونو بخير يارب هذا ملف به كود ممتاز يصلح لرجال التربيه والتعليم وخاصه رجال الكنترول شيت رائع وبه كود الحاله ( ناجح او له دور تان ) ما اسهله وما اروعه ===== Sub استخراج_حالة_الطالب() 'تم هذا الكود بواسطه المحترم ياسر العربي 'فائده هذا الكود هو استخراج حاله الطالب من 'ناجح او دور تان وكذلك استخراج مواد الدور لتاني 'تم في 28/8/2016 'حسب معطيات المحترم ابو احمد محمدي عبد السميع Dim ARR Dim ARRY Dim ARRYS '___________________________________________ Dim R As Long Dim X As Long Dim XX As Byte Dim ALL_LESS As String Dim Main As Worksheet Dim Info As Worksheet Set Main = Sheets("رصد الترم الثانى") Set Info = Sheets("بيانات المدرسة") '___________________________________________ Const STATUS As Byte = 133 'عمود الحالة ناجح او دور ثان Const NOTES As Byte = 134 ' عمود الملاحظات عمود المواد او منقول للصف ا لاخر Const GENDER As Byte = 141 ' عمود الجنس ذكر او أنثى Const TOTAL As Byte = 98 Const LESS_ROW As Byte = 6 'صف الدرجة الصغرى Const NAM_ROW As Byte = 2 'صف اسماء المواد Const NAME_FIRST As Byte = 6 ' (اول صف لاسماء الطلاب -1) Const Absent As Byte = 12 'عدد المواد لحساب الغياب Dim NAME_LAST As Long: NAME_LAST = Info.Range("B10").Value + NAME_FIRST ' عدد الطلاب '====== '_____________________________________________________ 'اعمدة اختبار الترم التاني 'رقم عمود المجموع يكتب هنا ARR = Array(10, 21, 32, 43, 135, 65, 72, 79, 86, 93, 105, 98) 'اعمدة الدرجة النهائية 'ايضارقم عمود المجموع يكتب هنا ARRY = Array(14, 25, 36, 47, 60, 68, 75, 82, 89, 96, 109, 98) 'اعمدة اسماء كل المواد 'ايضارقم عمود المجموع يكتب هنا ARRYS = Array(5, 16, 27, 38, 49, 63, 70, 77, 84, 91, 100, 98) '================= With Main 'اسم شيت البيانات Application.ScreenUpdating = False 'الغاء تحديث الشاشة Application.Calculation = xlManual ' ايقاف الحساب التلقائي For R = NAME_FIRST To NAME_LAST ' حلقة تكرارية تبدأ بأول اسم طالب الى اخر اسم For X = 0 To UBound(ARR) ' حلقة تكرارية تبدأ من الصفر الى اقصى مصفوفة اعمدة اختبار الفصل الدارسي الثاني On Error Resume Next '____________________________________________________ 'يتم حساب عدد ا لمواد المتغيب بها الطالب او درجتها صفر ويتم وضع عدد المواد في المتغير اكس اكس 'اذا وصل عدد المواد الى 11 اصبح الطالب متغيب If .Cells(R, ARRY(X)) = 0 Or .Cells(R, ARRY(X)) = "غ" Then XX = XX + 1 End If '___________________________________________________ If ARR(X) = TOTAL Then 'لايوجد اختلاف بين هذا الكود وبين الكود الموجود بالاسفل If .Cells(R, ARR(X)) < .Cells(LESS_ROW, ARR(X)) Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " لنصف الدرجة " & " - ": GoTo 86 GoTo 86 Else GoTo 86 End If End If '____________________________________________________ 'هنا يتم مقارنة المواد بالدرجة الصغرى الخاصة الفصل الدارسي الثاني في اول الكود او اذا كانت غياب يتم اضافة اسم المادة من صف المواد الى المتغير 'ALL_LESS 'او مقارنة الدرجة النهائية لكل مادة بالدرجة الصغرى لها او اذا كانت غياب اذا تحقق الشرط فيتم اضافة المادة الى المتغير 'ALL_LESS '______________________________________________________ If .Cells(R, ARR(X)) < .Cells(LESS_ROW, ARR(X)) Or .Cells(R, ARR(X)) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " لثلث الدرجة " & " - ": GoTo 86 End If If .Cells(R, ARRY(X)) < .Cells(LESS_ROW, ARRY(X)) Or .Cells(R, ARRY(X)) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " - " End If '______________________________________________________ 86 Next X 'الذهاب الى المادة الاخرى لاعادة تطبيق الكود مرة اخرى حتى انتهاء جميع المواد 'اذا كان المتغير اكس اكس بيساوي عدد المواد اذن الطالب متغيب If XX = Absent Then ALL_LESS = "غياب ": XX = 0 '_____________________________________________________ 'هنا بعد اكتمال الكود يتم عمل شرط للمتغير 'ALL_LESS 'اذا كان المتغير فارغ اي لم يتم اضافة اي مواد به اذا الطالب ناجح If ALL_LESS = "" Then If .Cells(R, GENDER) = "ذكر" Then .Cells(R, STATUS) = "ناجح " 'اذا كان نوع الطالب ذكر يتم وضع ناجح If .Cells(R, GENDER) = "أنثى" Then .Cells(R, STATUS) = "ناجحة " 'اذا كانت أنثى يتم وضع ناجحه If .Cells(R, GENDER) = "ذكر" Then .Cells(R, NOTES) = "ومنقول " & Info.Range("B16") 'ويتم وضع في الملاحظات منقول الى ويتم جلب الصف من صفحة الانفو If .Cells(R, GENDER) = "أنثى" Then .Cells(R, NOTES) = "ومنقولة " & Info.Range("B16") 'مثل ماسبق 'اما اذا كان المتغير يحمل اي بيانات لمواد يصبح الطالب له دور ثان ElseIf ALL_LESS <> "" Then If .Cells(R, GENDER) = "ذكر" Then .Cells(R, STATUS) = "له دور ثان في" 'مثل ما سبق بخصوص النوع If .Cells(R, GENDER) = "أنثى" Then .Cells(R, STATUS) = "لها دور ثان في" ' .Cells(R, NOTES) = Left(ALL_LESS, Len(ALL_LESS) - 2) 'هنا يتم وضع قيمة المتغير اي المواد في خلية الملاحظات ALL_LESS = Empty 'تفريغ المتغير لاعادة تعبئة اسم طالب اخر End If '_____________________________________________________ Next R 'الذهاب الى الصف التالي حتى انتهاء عدد الطلاب End With Application.ScreenUpdating = True 'اعادة تحديث الشاشة Application.Calculation = xlAutomatic 'تشغيل الحساب التلقائي End Sub استخراج حالة الطالب ومواد الرسوب نسخه منقحه1.rar
  7. السؤال عن أخ عزيز

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

    يحفظك الله ويرعاك اخي الكريم بن عليه الحل تمام لماذا تتحفظ على هذا الحل ؟
  9. شــيت الدور الثاني

    . بارك الله فيك اخي الكريم بن عليه هذه المعادلات لاتعمل جيدا مع اكسيل 2003 =_xlfn.IFERROR(IF(FIND($G$6;AK10);"دورثان");'تحريرى دور ثان'!G10) اريد بديلا لها يصلح .. من فضلك
  10. Sub Test() 'هذا الكود للمحترم ياسر العربي 'وتم اضافه وضع المسلسل بواسطه المهذب بن عليه 'حفظهم الله 'الهدف من الكود هو استدعاء بيانات اعمده ' لاعمده متفرقه مع وضع المسلسل توماتيكي '=========== Dim arr As Variant Dim temp As Variant Dim lr As Long Dim i As Long Dim j As Long Dim Main As Worksheet Dim sh As Worksheet Dim targt Set Main = Sheets("رصد الترم الثانى") Set sh = Sheets("بيانات الطلبة (2)") 'خليه البحث targt = sh.Range("D1").Value 'مدى المسح في صفحه الهدف sh.Range("B7:AN1000").ClearContents lr = Main.Cells(Rows.Count, 1).End(xlUp).Row 'مدى الصفحه الرئيسيه المصدر arr = Main.Range("A7:GB" & lr).Value ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2)) j = 1 For i = LBound(arr, 1) To UBound(arr, 1) 'If arr(i, 133) Like targt Then 'رقم عمود البحث If arr(i, 133) Like targt & "*" Then ' رقم عمود المسلسل temp(j, 1) = j 'العمود الاول بعد المسلسل temp(j, 2) = arr(i, 2) 'temp(j, 3) = arr(i, 3) temp(j, 4) = arr(i, 3) temp(j, 5) = arr(i, 141) temp(j, 6) = arr(i, 140) temp(j, 7) = arr(i, 149) temp(j, 8) = arr(i, 150) temp(j, 9) = arr(i, 151) temp(j, 10) = arr(i, 145) temp(j, 11) = arr(i, 142) temp(j, 12) = arr(i, 143) j = j + 1 End If Next i With sh 'خليه بدايه اللصق .Range("A7").Resize(j - 1, UBound(temp, 2)).Value = temp 'مدى المسح في صفحة الهدف .Range("B7:AM" & Rows.Count).Borders.Value = 0 'سطر لاضافة التسطير .Range("A7:P" & .Cells(Rows.Count, 4).End(xlUp).Row).Borders.Value = 1 End With End Sub الهدف من الكود هو استدعاء بيانات اعمده ' لاعمده متفرقه مع وضع المسلسل توماتيكي ================== المحترم بن عليه حاجي4.rar
  11. 'صمم بواسطة أ / محمد صالح 10/2/2011 'تم التعديل لإضافة الصفر والنصف 28/4/2015 'تم التعديل للوصول إلى 9999 والسماح بكتابة غ للغياب في 27/11/2017 ' https://a1mas.com Function n2t(d As String) As String If d = "" Or d = "غ" Then n2t = "غ" ElseIf d = 0 Or d > 9999.5 Then n2t = "لا شيء" ElseIf d = 0.5 Then n2t = "فقط نصف درجة" Else o = Int(d / 1000) m = Int(d / 100) - (o * 10) h = Int(d / 10) - (o * 100 + m * 10) a = Int(d - (o * 1000 + m * 100 + h * 10)) k = d - (o * 1000 + m * 100 + h * 10 + a) n2t = num((o), 4) & IIf(o > 0 And (a > 0 Or h > 0 Or m > 0), " و", "") & num((m), 3) & IIf(m > 0 And (a > 0 Or h > 0), " و", "") & num((a), 1) & IIf(a > 0 And h > 1, " و", " ") & num((h), 2) n2t = Replace(n2t, "و ", "و") n2t = Replace(n2t, "اثنتانِ عشرة", "اثنتا عشرة") n2t = Replace(n2t, "وعشرة", "وعشر") n2t = IIf(n2t = " عشرة", "عشر", n2t) n2t = IIf(n2t = "مائتانِ ", "مائتا", n2t) n2t = IIf(n2t = "ألفان ", "ألفا", n2t) n2t = "فقط " & n2t & IIf(h = 0 And a = 2, "درجتانِ", IIf((h = 1 And a = 0) Or ((h = 0 And a > 2)), " درجاتٍ", IIf(h = 0 And a = 0, " درجةٍ", " درجةً"))) & IIf(k > 0, " ونصفٌ", "") n2t = Replace(n2t, "إحدى درجةً", "درجةٌ") n2t = Replace(n2t, "اثنتانِ درجتانِ", "درجتانِ") n2t = Replace(n2t, "مائتانِ درجةٍ", "مائتا درجةٍ") End If n2t = Trim(n2t) End Function Function num(n As Integer, t As Integer) As String o = "ة آلاف" m = "مائة" h = "ونَ" Select Case n Case Is = 1 num = IIf(t = 4, "ألف", IIf(t = 3, m, IIf(t = 2, "عشرة", "إحدى"))) Case Is = 2 num = IIf(t = 4, "ألفان", IIf(t = 3, "مائتانِ", IIf(t = 2, "عشرونَ", "اثنتانِ"))) Case Is >= 3 num = IIf(t = 4, nn(n) & o, IIf(t = 3, nn(n) & m, IIf(t = 2, nn(n) & h, nn(n)))) End Select End Function Function nn(n As Integer) As String Select Case n Case Is = 3 nn = "ثلاث" Case Is = 4 nn = "أربع" Case Is = 5 nn = "خمس" Case Is = 6 nn = "ست" Case Is = 7 nn = "سبع" Case Is = 8 nn = "ثمان" Case Is = 9 nn = "تسع" End Select End Function الكود بعد التعديل للمحترم محمد صالح رزقه الله الرزق الواسع ونحن معه وان يصلح الله حاله وحالنا ..
  12. لا حرمك الله الاجر وجعله في ميزان حسناتك استاذ محمد صالح 'صمم بواسطة أ / محمد صالح 10/2/2011 'تم التعديل لإضافة الصفر والنصف 28/4/2015 'تم التعديل للوصول إلى 9999 والسماح بكتابة غ للغياب في 27/11/2017 ' https://a1mas.com Function n2t(d As String) As String If d = "" Or d = "غ" Then n2t = "غ" ElseIf d = 0 Or d > 9999.5 Then n2t = "لا شيء" ElseIf d = 0.5 Then n2t = "فقط نصف درجة" Else o = Int(d / 1000) m = Int(d / 100) - (o * 10) h = Int(d / 10) - (o * 100 + m * 10) a = Int(d - (o * 1000 + m * 100 + h * 10)) k = d - (o * 1000 + m * 100 + h * 10 + a) n2t = num((o), 4) & IIf(o > 0 And (a > 0 Or h > 0 Or m > 0), " و", "") & num((m), 3) & IIf(m > 0 And (a > 0 Or h > 0), " و", "") & num((a), 1) & IIf(a > 0 And h > 1, " و", " ") & num((h), 2) n2t = Replace(n2t, "و ", "و") n2t = Replace(n2t, "اثنتانِ عشرة", "اثنتا عشرة") n2t = Replace(n2t, "وعشرة", "وعشر") n2t = IIf(n2t = " عشرة", "عشر", n2t) n2t = IIf(n2t = "مائتانِ ", "مائتا", n2t) n2t = IIf(n2t = "ألفان ", "ألفا", n2t) n2t = "فقط " & n2t & IIf(h = 0 And a = 2, "درجتانِ", IIf((h = 1 And a = 0) Or ((h = 0 And a > 2)), " درجاتٍ", IIf(h = 0 And a = 0, " درجةٍ", " درجةً"))) & IIf(k > 0, " ونصفٌ", "") n2t = Replace(n2t, "إحدى درجةً", "درجةٌ") n2t = Replace(n2t, "اثنتانِ درجتانِ", "درجتانِ") n2t = Replace(n2t, "مائتانِ درجةٍ", "مائتا درجةٍ") End If n2t = Trim(n2t) End Function Function num(n As Integer, t As Integer) As String o = "ة آلاف" m = "مائة" h = "ونَ" Select Case n Case Is = 1 num = IIf(t = 4, "ألف", IIf(t = 3, m, IIf(t = 2, "عشرة", "إحدى"))) Case Is = 2 num = IIf(t = 4, "ألفان", IIf(t = 3, "مائتانِ", IIf(t = 2, "عشرونَ", "اثنتانِ"))) Case Is >= 3 num = IIf(t = 4, nn(n) & o, IIf(t = 3, nn(n) & m, IIf(t = 2, nn(n) & h, nn(n)))) End Select End Function Function nn(n As Integer) As String Select Case n Case Is = 3 nn = "ثلاث" Case Is = 4 nn = "أربع" Case Is = 5 nn = "خمس" Case Is = 6 nn = "ست" Case Is = 7 nn = "سبع" Case Is = 8 nn = "ثمان" Case Is = 9 nn = "تسع" End Select End Function الكود بعد التعديل للمحترم محمد صالح رزقه الله الرزق الواسع ونحن معه وان يصلح الله حاله وحالنا .. ===== =n2t(A1) هذه الجمله هي التي تكتب في صفحه ااكسيل وتكتب الارقام في الخليه A1 على سبيل المثال اخي الكريم انه يقرب الارقام بطريقه غير مفهومه
  13. Function n2t(d As Double) As String m = Int(d / 100) h = Int(d / 10) - (m * 10) a = Int(d - (m * 100 + h * 10)) k = d - (m * 100 + h * 10 + a) n2t = num((m), 3) & IIf(m > 0 And (a > 0 Or h > 0), " و ", "") & num((a), 1) & IIf(a > 0 And h > 1, " و ", " ") & num((h), 2) n2t = Replace(n2t, "اثنتانِ عشرة", "اثنتا عشرة") n2t = Replace(n2t, "ثمانمائة", "ثمنمائة") n2t = Replace(n2t, "ثلاثمائة", "ثلثمائة") n2t = Replace(n2t, "و عشرة", "و عشر") n2t = IIf(n2t = " عشرة", "عشر", n2t) n2t = IIf(n2t = "مائتانِ ", "مائتا", n2t) n2t = "فقط " & n2t & IIf(h = 0 And a = 2, "درجتانِ", IIf((h = 1 And a = 0) Or ((h = 0 And a > 2)), " درجاتٍ", IIf(h = 0 And a = 0, " درجةٍ", " درجةً"))) & IIf(k > 0, " و نصفٌ", "") n2t = Replace(n2t, " ", " ") n2t = Replace(n2t, "إحدى درجةً", "درجةٌ") n2t = Replace(n2t, "اثنتانِ درجتانِ", "درجتانِ") End Function Function num(n As Integer, t As Integer) As String m = "مائة" h = "ونَ" Select Case n Case Is = 1 num = IIf(t = 3, m, IIf(t = 2, "عشرة", "إحدى")) Case Is = 2 num = IIf(t = 3, "مائتانِ", IIf(t = 2, "عشرونَ", "اثنتانِ")) Case Is >= 3 num = IIf(t = 3, nn(n) & m, IIf(t = 2, nn(n) & h, nn(n))) End Select End Function Function nn(n As Integer) As String Select Case n Case Is = 3 nn = "ثلاث" Case Is = 4 nn = "أربع" Case Is = 5 nn = "خمس" Case Is = 6 nn = "ست" Case Is = 7 nn = "سبع" Case Is = 8 nn = "ثمان" Case Is = 9 nn = "تسع" End Select End Function هذا هو الكود الموجود في ملف الاخ الكريم ويريد التفقيط لاكثر من 1200 درجة فياريت التكرم ومساعدته بارك الله فيكم
  14. اخي الكريم استاذ عبد الحميد السلام عليكم ورحمة الله ان كنت شعرت بنغمه حده في حواري .. اولا انا لم اقصد ولم افكر في اي نغمه حده لكن مادمت شعرت بذلك فارجو ان تقبل اعتذاري لشخصك الكريم جزاك الله خيرا
×