logo

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
abdelmoniem ismail لا تميز خلال هذه الفترة-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة توزيع المعلمين في جدول الحصص حسب النصاب بشروط اكسيل مشاريع جاهزه



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





26-10-2018 05:45 صباحاً
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
نزولاُ عند رغبة بعض الأصدقاء و متابعة للموضوع على هذا العنوان ( المراتب من 1 الى مئة)
http://techno7asry.com/forum/t2029
تم زيادة النطاق لغاية الرقم 1000
و بذلك يكتب لك الاكسل مثلاً الرقم 125 (مئة وخمسة وعشرون) : الرقم 934 (تسعمئة وأربعة وثلاثون)
الكود
CODE

Option Explicit

Function Order_Salim(cel)
Dim degree$, i%, My_num1%, My_num2%
Dim aHad$, Asharat$
If Not IsNumeric(cel) Then Order_Salim = "N/A": Exit Function
 If cel = 100 Then
  Order_Salim = "المائة": Exit Function
 End If
 If cel > 100 Then
  Order_Salim = "too Big Number": Exit Function
 End If
cel = Int(Abs(cel))
Dim deg1$, deg2$, deg3$, deg4$, deg5$, deg6$, deg7$, deg8$, deg9$, deg10$
   deg1 = "الأوّل": deg2 = "الثّاني": deg3 = "الثّالث": deg4 = "الرّابع"
   deg5 = "الخامس": deg6 = "السّادس": deg7 = "السّابع": deg8 = "الثّامن": deg9 = "التّاسع": deg10 = "العاشر"
Dim deg01$, deg02$, deg03$, deg04$, deg05$, deg06$, deg07$, deg08$, deg09$
    deg01 = "عشر": deg02 = "والعشرون": deg03 = "والثّلاثون": deg04 = "والأربعون": deg05 = "والخمسون"
    deg06 = "والستون": deg07 = "والسّبعون": deg08 = "والثّمانون": deg09 = "والتّسعون"
    If cel < 11 Then
    Select Case cel
            Case Is = 1:   degree = deg1
            Case Is = 2:   degree = deg2
            Case Is = 3:   degree = deg3
            Case Is = 4:   degree = deg4
            Case Is = 5:   degree = deg5
            Case Is = 6:   degree = deg6
            Case Is = 7:   degree = deg7
            Case Is = 8:   degree = deg8
            Case Is = 9:   degree = deg9
            Case Is = 10: degree = deg10
    End Select
Order_Salim = degree: Exit Function
Else
  My_num1 = Mid(cel, 2, 1)
  '===========================
  Select Case My_num1
                           
        '=======================
            Case Is = 1:   aHad = "الحادي"
            Case Is = 2:  aHad = deg2
            Case Is = 3:   aHad = deg3
            Case Is = 4:   aHad = deg4
            Case Is = 5:   aHad = deg5
            Case Is = 6:   aHad = deg6
            Case Is = 7:  aHad = deg7
            Case Is = 8:  aHad = deg8
            Case Is = 9:  aHad = deg9

  End Select
  '======================
    My_num2 = Mid(cel, 1, 1)
  Select Case My_num2
            Case Is = 1:   Asharat = deg01
            Case Is = 2:   Asharat = deg02
             Case Is = 3:   Asharat = deg03
             Case Is = 4:   Asharat = deg04
             Case Is = 5:   Asharat = deg05
             Case Is = 6:   Asharat = deg06
             Case Is = 7:   Asharat = deg07
            Case Is = 8:    Asharat = deg08
            Case Is = 9:    Asharat = deg09

    End Select
  
     If My_num1 = 0 Then
        Order_Salim = Right(aHad & " " & Asharat, Len(aHad & " " & Asharat) - 2)
        Else
        Order_Salim = aHad & " " & Asharat
    End If
  End If
End Function
 Function OrdeUP100(cel)
 If Not IsNumeric(cel) Or Int(cel) <> cel Or Int(cel) <= 0 Then
 OrdeUP100 = "ERROR": Exit Function
 End If
 If cel = 1000 Then OrdeUP100 = "الألف": Exit Function
 If cel > 1000 Then OrdeUP100 = "Too Large Integer": Exit Function

 Dim Mi3at, Free, Martab1
  If cel <= 99 Then OrdeUP100 = Order_Salim(cel): Exit Function
   Select Case Left(cel, 1)
  Case Is = 1: Mi3at = "مئة"
  Case Is = 2: Mi3at = "مئتين"
  Case Is = 3: Mi3at = "ثلاثمائة"
  Case Is = 4: Mi3at = "أربعمئة"
  Case Is = 5: Mi3at = "خمسمئة"
  Case Is = 6: Mi3at = "ستممئة"
  Case Is = 7: Mi3at = "سبعمئة"
  Case Is = 8: Mi3at = "ثمانمئة"
  Case Is = 9: Mi3at = "تسعممئة"
  End Select
  If Mid(cel, 2, 1) = 0 Then
     Free = Right(cel, 1)
      Select Case Free
       Case 0: Martab1 = ""
       Case 1: Martab1 = " وواحد"
       Case 2: Martab1 = "وإثنين"
       Case 3: Martab1 = "وثلاثة"
       Case 4: Martab1 = "وأربعة"
       Case 5: Martab1 = "وخمسة"
       Case 6: Martab1 = "وستة"
       Case 7: Martab1 = "وسبعة"
       Case 8: Martab1 = "وثمانية"
       Case 9: Martab1 = "وتسعة"
      End Select
      OrdeUP100 = Mi3at & " " & Martab1: Exit Function
      End If

OrdeUP100 = Mi3at & " و" & Order_Salim(Mid(cel, 2, 2) * 1)

 End Function



الملف مرفق
 
 
  order_up_to_1000.rar   تحميل rar مرات التحميل :(5)
الحجم :(36.363) KB





look/images/icons/i1.gif ترقية UDF
  26-10-2018 07:04 صباحاً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10529
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36752
الاعجاب : 184
بارك الله فيك أخي الحبيب سليم وجزاك الله خيراً
دالة رائعة من إنسان رائع




اضافة رد جديد اضافة موضوع جديد



المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
مبارك استاذ حسونة الترقية Yasser Elaraby
14 2288 علي بطيخ سالم
معرفة ميعاد ترقية المعلمين علي بطيخ سالم
3 934 مهند محسن
تهنئة للمهندس عبد الكريم قرعوش بالترقية إلى عضو محترف محمد حسن المحمد
12 2263 Abdulkareem87
تهنئة - أستاذ خالد البوريني khaled alborene على الترقية للقب العضو المتميز Yasser Elaraby
14 3290 amaar
فتح باب تسجيل المعلمين والاخصائيين للترقية لتعيينات الكادر ٢٠١٤ بجميع المحافظات Yasser Elaraby
6 2378 Mo.Saber

الكلمات الدلالية
ترقية ،









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

الساعة الآن 05:49 PM