هديتي للمنتدى الارقام العربية

السلام عليكم

مرحبااااااااااااااا بكم أخوانى وجزاكم الله خير على الموضوع الجميلة وعلى سرعة الاستجابة والتعديل السريع جدا

هحمل المرفقات وجاااااااااااااارى التجربة

سؤال

1-لماذا لا يتم تثبيت هذا الموضوع ؟؟؟؟؟؟

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

تحياتى .....................

cdcase كتب:

1-لماذا لا يتم تثبيت هذا الموضوع ؟؟؟؟؟؟

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

تحياتى .....................

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

اما بخصوص شرح الكود فاعتقد انه اذا تغاضينا عن عموض مسميات المتغيرات واستخدام احرف قليلة في تسميتها بسبب الرغبة في تقليل مساحة الكود، فإن الكود واضح من حيث تقسيمه كما ذكرت للارقام لمناطق تشمل ارقام الاحاد والعشرات والمئات - والواحد الف والواحد مليون .. الخ - والمائة الف والمائة مليون .. الخ .. الخ ..

واضيف ايضا اقتراح اصر عليه هو اني لست عضو جديد كما هو مذكور تحت اسمي لاني متابع للفريق العربي قبل وضع المنتدي منذ ان كان موقع على الانترنت و شاركت بالمنتدى من بدايته غير ان مشاركتي محدودة قليلاً :D للاسف ولاداعي لذكر الاسباب.

ASMSA كتب:

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

اما بخصوص شرح الكود فاعتقد انه اذا تغاضينا عن عموض مسميات المتغيرات واستخدام احرف قليلة في تسميتها بسبب الرغبة في تقليل مساحة الكود، فإن الكود واضح من حيث تقسيمه كما ذكرت للارقام لمناطق تشمل ارقام الاحاد - والواحد الف والواحد مليون .. الخ - والمائة الف والمائة مليون .. الخ .. الخ ..

جزاك الله خيراً يا أخى

على فكرة الكود يعمل بكفاءة عالية وخالى من الاخطاااااااااااء

وبالنسبة للشرح سأحاول جاهدا ان افهمه وسأتغاضى عن مسميات المتغيرات كما ذكرت وسأرى

شكراً لك أخى

تحياتى

cdcase كتب:

جزاك الله خيراً يا أخى

على فكرة الكود يعمل بكفاءة عالية وخالى من الاخطاااااااااااء

وبالنسبة للشرح سأحاول جاهدا ان افهمه وسأتغاضى عن مسميات المتغيرات كما ذكرت وسأرى

شكراً لك أخى

تحياتى

اشكر كثير الشكر على اهتمامك وبشكرك الله بالجنة جزاء بشراك لي بانه خالــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــي من الاخطاء .. تحياتي لك دائما

السلام عليكم و رحمة الله و بركاته

أعتقد أن أنسب مكان للموضوع هو ( أرشيف الدروس و المواضيع المتنوعه ) نظرا لكثرة قراءة الموضوع

عمرو عيسي

لم أدرس الكود جيدا بس نتيجة التجربة لازالت هناك أخطاء بالكود في الفاصلة العشرية

على سبيل المثال وليس الحصر

مثلا الرقم 1512.30 يعطي النتيجة الف و خمس مائة و اثنا عشر ريال و هللة - تفقيط الكسور غلط

مثلا 1512.6 يعطي النتيجة الف و خمس مائة و اثنا عشر ريال و ستة هللة - الصحيح ستون وليس ستة

samerselo كتب:

لم أدرس الكود جيدا بس نتيجة التجربة لازالت هناك أخطاء بالكود في الفاصلة العشرية

على سبيل المثال وليس الحصر

مثلا الرقم 1512.30 يعطي النتيجة الف و خمس مائة و اثنا عشر ريال و هللة - تفقيط الكسور غلط

مثلا 1512.6 يعطي النتيجة الف و خمس مائة و اثنا عشر ريال و ستة هللة - الصحيح ستون وليس ستة

مرحباااااااااا

غريبة ازاى فاتت عليا المشكلة ديه

اخى ASMSA من فضلك اقبل اعتذارى لاننى من الواضح لم أختبر الكود بشكل كامل

ولكن هل من حل لهذا الخطأ

تحياتى

شكرا اخى الكريم

ASMSA كتب:

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

الكود:

Private Function ToWordsArb(Num As String) As String
    Dim S1 As String, S2 As String, S3 As String, Tmp As String, X As String
    Dim L As Integer, T As Integer, R As Integer, T_ As String
    Const S As String = " ": Const O As String = " و "
    T_ = "الاف"
    
    
    'Fill Array'''''''''''''''''''(1 to 9)'''''''''''''''''''''
    Dim AN(0 To 9) As String 'Data for conversion
    AN(1) = "واحد": AN(2) = "اثنان": AN(3) = "ثلاثة"
    AN(4) = "اربعة": AN(5) = "خمسة": AN(6) = "ستة"
    AN(7) = "سبعة": AN(8) = "ثمانية": AN(9) = "تسعة"
    ''''''''''''''''''''(11 to 19 )'''''''''''''''''''''''''''''
    Dim BN(0 To 9) As String
    BN(0) = "عشرة"
    BN(1) = "احد عشر": BN(2) = "اثنا عشر": BN(3) = "ثلاثة عشر"
    BN(4) = "اربع عشر": BN(5) = "خمسة عشر": BN(6) = "ستة عشر"
    BN(7) = "سبعة عشر": BN(8) = "ثمانية عشر": BN(9) = "تسعة عشر"
    ''''''''''''''''''''(10 to 90)'''''''''''''''''''''''''''''''''''
    Dim CN(0 To 9) As String
    CN(1) = "عشرة": CN(2) = "عشرين": CN(3) = "ثلاثين"
    CN(4) = "اربعين": CN(5) = "خمسين": CN(6) = "ستين"
    CN(7) = "سبعين": CN(8) = "ثمانين": CN(9) = "تسعين"
    ''''''''''''''''''''(100 to 900)'''''''''''''''''''''''''''''''''''
    Dim DN(0 To 9) As String
    DN(1) = "مائة": DN(2) = "مائتين": DN(3) = "ثلاث مائة"
    DN(4) = "اربع مائة": DN(5) = "خمس مائة": DN(6) = "ست مائة"
    DN(7) = "سبع مائة": DN(8) = "ثمان مائة": DN(9) = "تسع مائة"
    'ZEROs''''''''''''''''''''''''''''''
    AN(0) = "": BN(0) = "عشرة": CN(0) = "": DN(0) = ""
    'Make redey''''''''''''''''''''''''''''''

    L = Len(Num)

'''''''''''''''''''''''''''''''''Check Start: ''''''''''''''''''''''''''''''''''''''''''''
''ALL BY ORDER :'''''''''''''''''''''''''''''

Dim W As Collection, C As Integer, MM As String
Set W = New Collection
        'Split numbers to array
        For T = L To 1 Step -1
        MM = Mid(CStr(Num), T, 1)
        If IsNumeric(MM) Then W.Add MM
        Next T
'Exit if it Zero'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Num = Replace(Num, "|", ""): If Val(Num) = 0 Then X = "صفر": GoTo Ex '''
 C = W.Count: L = C  'Very Important                                  '''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    '1 Check''1 to 9
    If L = 1 Then X = AN(Val(Num)): GoTo Ex
    
    '2 Check'11-12-13....To: 19
    If L = 2 Then If Val(W.Item(2)) = 1 Then _
    X = BN(Val(W.Item(1))): GoTo Ex
    
    '2 Check'10-20-30....To: 90
    If L = 2 Then If Val(W.Item(1)) = 0 Then _
    X = CN(Val(W.Item(1))): GoTo Ex
    
     '3 Check'From 21 ....To: 90
    If L = 2 Then X = AN(Val(W.Item(1))) & O & CN(Val(W.Item(2))): GoTo Ex

Re_Check:
'3 Check' The Tow Frist Numbers of Large number:
    If Val(W.Item(2)) = "1" Then 'Elvenths(BN)
    X = BN(Val(Val(W.Item(1))))
    X = X
    ElseIf Val(W.Item(1)) = "0" Then 'Tointeth(CN)
    X = CN(Val(Val(W.Item(2))))
    Else
    X = AN(Val(W.Item(1))) & O & CN(Val(W.Item(2)))  'From 21-67 ....To: 90
    End If
   
X = Zeros(W, X, 2)
    
'4 Check ' 12-31-41... to end'''

If L > 2 Then 'Hundreds(DN)
X = DN(Val(W.Item(3))) & O & X 'Hundreds & Numbers
If W.Item(1) = "0" And W.Item(2) = "0" Then X = DN(Val(W.Item(3))) 'Hundreds & Zeros

X = Zeros(W, X, 3)
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If L = 4 Then ' Thawsend(1,000)''4 Numbers'''''''''''''''''''''''''''''''

    If Val(W.Item(4)) = 1 Then
    Tmp = "الف"
    ElseIf Val(W.Item(4)) = 2 Then
    Tmp = "الفين"
    Else
    Tmp = "الاف"
    End If
    
    If Tmp = "الاف" Then X = AN(Val(W.Item(4))) & S & Tmp & O & X Else X = Tmp & O & X  'Thawsend & Numbers
    
    If W(2) = "0" & W(3) = "0" & W(4) = "0" Then _
    If Tmp = "الاف" Then X = AN(Val(W.Item(1))) & S & Tmp Else X = Tmp 'Thawsend & Zeros
    
X = Zeros(W, X, 4)
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'If L > 4 And L < 8 Then '10 Thawsend(10,000)''5 Numbers'''''''''''''''''''''''''''''''
If L > 4 Then ''___ OPEN IF ______________________________________________(L > 4)

TenThawsend: '10 Thawsend(10,000)''5 Numbers'''''''''''''''''''''''''''''''
Tmp = ""
If W(5) = "0" Then GoTo HoundredsThawsend 'Jump

    If Val(W.Item(5)) = 1 Then
    Tmp = "عشرة الاف"
    ElseIf Val(W.Item(5)) = 2 Then
    Tmp = "عشرين الف"
    End If


        If W(4) = "0" Then '10.000
        If Val(W.Item(5)) = 1 Or Val(W.Item(5)) = 2 Then X = Tmp & O & X Else _
        T_ = "الف": X = CN(Val(W(5))) & S & T_ & O & X
        Else '11.000
        T_ = "الف"
        If W(5) = "1" Then X = BN(Val(W(4))) & S & T_ & O & X
        If W(5) <> "1" Then X = AN(Val(W(4))) & O & CN(Val(W(5))) & S & T_ & O & X
        End If
        
If L = 5 Then GoTo Ex '100 Thawsend(100,000)''6 Numbers''''''''''''''''''''''''''''''
HoundredsThawsend:

If W(6) = "0" Then GoTo Mileons 'Jump
X = Zeros(W, X, 5)

Tmp = "الف"

If W(5) = "0" And W(4) = "0" Then
X = DN(Val(W(6))) & S & Tmp & O & X
Else
    If W(5) = 0 Then
    If Val(W(6)) > 2 Then Tmp = "الاف"
    If Val(W(5)) = 0 Then If Val(W(4)) > 2 Then Tmp = "الاف" Else Tmp = "الف"
    X = DN(Val(W(6))) & O & AN(Val(W(4))) & S & Tmp & O & X 'tx here
    Else
    X = DN(Val(W(6))) & O & X
    End If
End If
X = Replace(X, "مائتين الف", "مئتي الف")
X = Replace(X, " الف الف ", " الف ")

If L < 7 Then GoTo Ex 'Milon(1000,000)''7 numbers'''''''''''''''''''''''''''''''
Mileons:

If Val(W.Item(7)) < 1 Then GoTo TenMileons 'Jump
If L > 7 Then If Val(W.Item(8)) <> 0 Then GoTo TenMileons 'Jump
If L > 8 Then If Val(W(9)) <> 0 Then GoTo TenMileons 'Jump

Tmp = "ملاين"

    
    If Val(W.Item(7)) = 1 Then
    Tmp = "مليون"
    ElseIf Val(W.Item(7)) = 2 Then
    Tmp = "مليونين"
    End If
    
X = Zeros(W, X, 6)
    
If Val(W.Item(7)) > 2 Then X = AN(Val(W(7))) & S & Tmp & O & X Else X = Tmp & O & X

If L < 8 Then GoTo Ex 'Milon(10,000,000)''8 numbers'''''''''''''''''''''''''''''''
TenMileons:
If L > 8 Then If Val(W(9)) <> 0 Or Val(W(8)) < 1 Then GoTo HoundredsMileons 'Jump

If Val(W(8)) = 1 Then Tmp = "ملاين" Else Tmp = "مليون"

X = Zeros(W, X, 6)
X = Zeros(W, X, 7)

    If Val(W(8)) = 1 Then 'Tenth Mileons:10,000,000
    If Val(W(7)) = 0 Then X = CN(Val(W(8))) & S & Tmp & O & X Else _
    Tmp = "مليون": X = BN(Val(W(7))) & S & Tmp & O & X 'Elventh Mileons
    Else
    If Val(W(7)) = 0 Then X = CN(Val(W(8))) & S & Tmp & O & X Else _
     X = AN(Val(W(7))) & O & CN(Val(W(8))) & S & Tmp & O & X   '12,000,000
    End If

If L < 9 Then GoTo Ex 'Milon(100,000,000)''9 numbers'''''''''''''''''''''''''''''''
HoundredsMileons:
If L > 9 And Val(W(9)) < 1 Then GoTo Bileon

Tmp = "مليون"
X = Zeros(W, X, 8)

    If Val(W(7)) = 0 And Val(W(8)) = 0 Then    '100,000,000
    X = DN(Val(W(9))) & S & Tmp & O & X 'Puer Houndreds Of Mileons
    Else '110,000,000
    '1- Houndreds Of Mileons & Elvenths : ..2- Else :Houndreds Of Mileons & Frist numbers
    If Val(W(8)) = 1 Then X = DN(Val(W(9))) & O & BN(Val(W(7))) & S & Tmp & O & X Else _
    X = DN(Val(W(9))) & O & AN(Val(W(7))) & S & CN(Val(W(8))) & S & Tmp & O & X
    End If
X = Replace(X, "مائتين مليون", "مئتي مليون")

If L < 10 Then GoTo Ex 'Bileon(1,000,000,000)''10 numbers'''''''''''''''''''''''''''''''
Bileon:

If Val(W.Item(10)) < 1 Then GoTo Ten_Of_Bileons 'Jump
If L > 10 Then If Val(W.Item(11)) <> 0 Then GoTo Ten_Of_Bileons 'Jump
If L > 11 Then If Val(W(12)) <> 0 Then GoTo Ten_Of_Bileons 'Jump


Tmp = "بلاين"

    If Val(W.Item(10)) = 1 Then
    Tmp = "بليون"
    ElseIf Val(W.Item(10)) = 2 Then
    Tmp = "بليونين"
    End If
    
X = Zeros(W, X, 9)

If Val(W.Item(10)) > 2 Then X = AN(Val(W(10))) & S & Tmp & O & X Else X = Tmp & O & X

If L < 11 Then GoTo Ex 'Bileon(10,000,000,000)''11 numbers'''''''''''''''''''''''''''''''
Ten_Of_Bileons:

If L > 11 Then If Val(W(12)) <> 0 Or Val(W(11)) < 1 Then GoTo Houndred_Of_Bileons 'Jump

If Val(W(11)) = 1 Then Tmp = "بلاين" Else Tmp = "بليون"

X = Zeros(W, X, 11)

    If Val(W(11)) = 1 Then 'Tenth Bileons:10,000,000,000
    If Val(W(10)) = 0 Then X = CN(Val(W(11))) & S & Tmp & O & X Else _
    Tmp = "بليون": X = BN(Val(W(10))) & S & Tmp & O & X 'Elventh Bileons
    Else
    If Val(W(10)) = 0 Then X = CN(Val(W(11))) & S & Tmp & O & X Else _
     X = AN(Val(W(10))) & O & CN(Val(W(11))) & S & Tmp & O & X   '12,000,000,000
    End If
    
If L < 12 Then GoTo Ex 'Bileon(100,000,000,000)''12 numbers'''''''''''''''''''''''''''''''
Houndred_Of_Bileons:
If L > 12 And Val(W(12)) < 1 Then GoTo Trlion

Tmp = "بليون"
X = Zeros(W, X, 12)

    If Val(W(10)) = 0 And Val(W(11)) = 0 Then    '100,000,000,000
    X = DN(Val(W(12))) & S & Tmp & O & X 'Puer Houndreds Of Bileons
    Else '110,000,000,000
    '1- Houndreds Of Bileons & Elvenths : ..2- Else :Houndreds Of Bileons & Frist numbers
    If Val(W(11)) = 1 Then X = DN(Val(W(12))) & O & BN(Val(W(10))) & S & Tmp & O & X Else _
    X = DN(Val(W(12))) & O & AN(Val(W(10))) & S & CN(Val(W(11))) & S & Tmp & O & X
    End If
    
X = Replace(X, "مائتين بليون", "مئتي بليون")

If L < 13 Then GoTo Ex 'Trlion(1,000,000,000,000)''13 numbers'''''''''''''''''''''''''''''''
Trlion:

If Val(W.Item(13)) < 1 Then GoTo Ten_Of_Trlions 'Jump
If L > 13 Then If Val(W.Item(14)) <> 0 Then GoTo Ten_Of_Trlions 'Jump
If L > 14 Then If Val(W.Item(15)) <> 0 Then GoTo Ten_Of_Trlions 'Jump


Tmp = "تريلونات"

    If Val(W.Item(13)) = 1 Then
    Tmp = "ترليون"
    ElseIf Val(W.Item(13)) = 2 Then
    Tmp = "ترليونين"
    End If
    
    
X = Zeros(W, X, 13)
If Val(W.Item(13)) > 2 Then X = AN(Val(W(13))) & S & Tmp & O & X Else X = Tmp & O & X

If L < 14 Then GoTo Ex 'Ten_Of_Trlions(10,000,000,000,000)''14 numbers'''''''''''''''''''''''''''''''
Ten_Of_Trlions:

If L > 14 Then If Val(W(15)) <> 0 Or Val(W(14)) < 1 Then GoTo Houndreds_Of_Trlions 'Jump

If Val(W(14)) = 1 Then Tmp = "تريلونات" Else Tmp = "ترليون"

X = Zeros(W, X, 14)

    If Val(W(14)) = 1 Then 'Tenth Trlions:10,000,000,000,000
    If Val(W(13)) = 0 Then X = CN(Val(W(14))) & S & Tmp & O & X Else _
    Tmp = "ترليون": X = BN(Val(W(13))) & S & Tmp & O & X 'Elventh Trlions
    Else
    If Val(W(13)) = 0 Then X = CN(Val(W(14))) & S & Tmp & O & X Else _
     X = AN(Val(W(13))) & O & CN(Val(W(14))) & S & Tmp & O & X   '12,000,000,000,000
    End If
    
If L < 15 Then GoTo Ex 'Houndreds_Of_Trlions(100,000,000,000,000)''15 numbers'''''''''''''''''''''''''''''''
Houndreds_Of_Trlions:
If L > 15 And Val(W(15)) < 1 Then GoTo Quadrillion

Tmp = "ترليون"
X = Zeros(W, X, 15)

    If Val(W(13)) = 0 And Val(W(14)) = 0 Then    '100,000,000,000,000
    X = DN(Val(W(15))) & S & Tmp & O & X 'Puer Houndreds Of Trlions
    Else '110,000,000,000,000
    '1- Houndreds Of Trlions & Elvenths : ..2- Else :Houndreds Of Trlions & Frist numbers
    If Val(W(14)) = 1 Then X = DN(Val(W(15))) & O & BN(Val(W(13))) & S & Tmp & O & X Else _
    X = DN(Val(W(15))) & O & AN(Val(W(13))) & S & CN(Val(W(14))) & S & Tmp & O & X
    End If
    
X = Replace(X, "مائتين ترليون", "مئتي ترليون")

If L < 16 Then GoTo Ex 'Quadrillion(1,000,000,000,000,000)''16 numbers'''''''''''''''''''''''''''''''
Quadrillion:

If Val(W.Item(16)) < 1 Then GoTo Ten_Of_Quadrillions 'Jump
If L > 16 Then If Val(W.Item(17)) <> 0 Then GoTo Ten_Of_Quadrillions 'Jump
If L > 17 Then If Val(W.Item(18)) <> 0 Then GoTo Ten_Of_Quadrillions 'Jump


Tmp = "كوادرليونات"

    If Val(W.Item(16)) = 1 Then
    Tmp = "كوادرليون"
    ElseIf Val(W.Item(16)) = 2 Then
    Tmp = "كوادرليونين"
    End If
    
    
X = Zeros(W, X, 16)
If Val(W.Item(16)) > 2 Then X = AN(Val(W(16))) & S & Tmp & O & X Else X = Tmp & O & X

If L < 17 Then GoTo Ex 'Ten_Of_Quadrillions(10,000,000,000,000,000)''17 numbers'''''''''''''''''''''''''''''''
Ten_Of_Quadrillions:

If L > 17 Then If Val(W(18)) <> 0 Or Val(W(17)) < 1 Then GoTo Houndreds_Of_Quadrillions 'Jump

If Val(W(17)) = 1 Then Tmp = "كوادرليونات" Else Tmp = "كوادرليون"

X = Zeros(W, X, 17)

    If Val(W(17)) = 1 Then 'Tenth Quadrillions
    If Val(W(16)) = 0 Then X = CN(Val(W(17))) & S & Tmp & O & X Else _
    Tmp = "كوادرليون": X = BN(Val(W(16))) & S & Tmp & O & X 'Elventh Quadrillions
    Else
    If Val(W(16)) = 0 Then X = CN(Val(W(17))) & S & Tmp & O & X Else _
     X = AN(Val(W(16))) & O & CN(Val(W(17))) & S & Tmp & O & X   '12,000,000,000,000,000
    End If
    
If L < 18 Then GoTo Ex 'Houndreds_Of_Quadrillions(100,000,000,000,000,000)''18 numbers'''''''''''''''''''''''''''''''
Houndreds_Of_Quadrillions:

If L > 18 And Val(W(18)) < 1 Then GoTo Zlion

Tmp = "كوادرليون"
X = Zeros(W, X, 18)

    If Val(W(16)) = 0 And Val(W(17)) = 0 Then    '100,000,000,000
    X = DN(Val(W(18))) & S & Tmp & O & X 'Puer Houndreds Of Quadrillions
    Else '110,000,000,000
    '1- Houndreds Of Quadrillions & Elvenths : ..2- Else :Houndreds Of Quadrillions & Frist numbers
    If Val(W(17)) = 1 Then X = DN(Val(W(18))) & O & BN(Val(W(16))) & S & Tmp & O & X Else _
    X = DN(Val(W(18))) & O & AN(Val(W(16))) & S & CN(Val(W(17))) & S & Tmp & O & X
    End If
    
X = Replace(X, "مائتين كوادرليون", "مئتي كوادرليون")

If L < 19 Then GoTo Ex 'Houndreds_Of_Quadrillions(100,000,000,000,000,000)''18 numbers'''''''''''''''''''''''''''''''
Zlion: '[The end]'''Last Naming number
X = "": X = "زليون" & vbCrLf & "الزليون : رقم غير محدود يفوق التسميات المعروفة"

End If ''___ CLOSE IF ______________________________________________(L > 4)
'''''''''''''''''''''''''''''''''Check End: ''''''''''''''''''''''''''''''''''''''''''''''

Ex:
Set W = Nothing
X = Replace(X, O & O, O) ''Delte extra waws
'delete last waw
If Len(X) > 2 Then _
If Mid(X, Len(X) - 2, 2) = " و" Or Mid(X, Len(X) - 2, 2) = "و " Then X = Left(X, Len(X) - 2)
ToWordsArb = X
End Function
Private Function Zeros(Col As Collection, X As String, MAX As Integer) As String
Dim T As Integer, I As Boolean
If MAX < 1 Then Exit Function
    For T = 1 To Col.Count
    If Val(Col.Item(T)) <> 0 Then I = True: Exit For
    If T = MAX Then Exit For
    Next T
If I Then Zeros = X Else Zeros = ""
End Function

تـم تعديل الكود باخر صفحة من هذا الموضوع فالرجاء الانتقال اليها لتحميل احدث كود بعد التنقيح النهائي

ممتازززززززززززززز

cdcase كتب:

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

أخى مشكور جدا على تعبك وتعديلك للكود ليعمل على الدوت نت ولكن يوجد خطأن 1-من بعد العدد (1000) إلى (9999) 2- انه يتجاهل العلامة العشرية تمام ويكمل التفقيط على إنهم أرقام صحيحة

إنظر المرفقات

أرجو الافادة

واتمنى ان اكون على خطأ ؟

تحياتى

خطأ غريب والأغرب انى لم أكتشفه الا الان :unsure: واتمنى ان لا يكون فات الاوان

وهو انه لا يترجم الارقام من 20 الى 90

أرجو لمن يتابع هذا الموضوع أن يوافينا بالحل

تحياااااااتى

-_- أوه حسناً سأخبرك بشيء قبل 7 سنوات تقريباً عندما كنت على مقاعد الدراسة

أذكر أنه كان لدينا معلم رياضيات و أخبرنا بأن له زميل صنع مثل هذا البرنامج الذي صنعته برنامج تقفيط

و باعه على احد البنوك بكم تتوقع أشتروه

200 الف ريال :wacko:

و لذلك لك مني 200 الف :clapping: :clapping: شكر :lol:

مع جزيل الشكر والعرفان لصاحب الموضوع

ومن قام بالتعديل عليه

للاسف يوجد اخطاء بسيطه بالكود والبرنامج

وهو عند كتابة 20 او 30 او 40 ... إلى 90 فقط بالصفر

وايضا عند كتابتها بعد الفاصلة

ام عند كتابة 21 ...و 31 ....و إلى ... 99 فهي صحيح لا يجود بها اخطاء او بالاصح يقوم بقراءتها او تفقيطها بشكل صحيح

sandm كتب:

مع جزيل الشكر والعرفان لصاحب الموضوع

ومن قام بالتعديل عليه

للاسف يوجد اخطاء بسيطه بالكود والبرنامج

وهو عند كتابة 20 او 30 او 40 ... إلى 90 فقط بالصفر

وايضا عند كتابتها بعد الفاصلة

ام عند كتابة 21 ...و 31 ....و إلى ... 99 فهي صحيح لا يجود بها اخطاء او بالاصح يقوم بقراءتها او تفقيطها بشكل صحيح

اشكر عزيزي "sandm" على ملاحظتك ،،، نعم كان هناك خطأ جدا بسيط في الكود :

            '2 Check'10-20-30....To: 90
            If L = 2 Then If Val(W.Item(1)) = 0 Then _
            X = CN(Val(W.Item(1))) : GoTo Ex

بمحرف واحد وهو الرقم 1 والصيحيح هو أثنان ليكون كالتالي:

            '2 Check'10-20-30....To: 90
            If L = 2 Then If Val(W.Item(1)) = 0 Then _
            X = CN(Val(W.Item(2))) : GoTo Ex

لكن على أي حال أيضا أجريت تحسينات عديدة على الكود وذلك بسبب أني أعمل على برنامج أكسيس لإستخدامه بأحد مواقع المبيعات بالسوق ،، وساضيف هذا الكود للتفقيط بالبرنامج -

وبخصوص رد الزميل محمد أبو سامر بوجود خطأ عند نطق الرقم 1512.30 ،، !! فالحقيقة ان الكود الآن جدا متكامل ولم أجد أية أخطاء به .. وعموما لك مني الشكر على اهتمامك

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

وبما أن الكود الآن أصبح مشروع كود بتعاونكم ومراجعتكم له ،، فأرجوا منك الإستمرار ومتابعة الموضوع ،، وبناء على ذك الكود أدناه كما ذكرت أعلاه هو بعد عدة تنقيحات ،، وهو بتنسيق الفيجوال بيسك6 ليمكن استخدامه (ببرامج الأوفيس كالاكسيل والأكسيس) فاتمنا أن ينال أعجابكم واستحسانكم :

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Function ToWordsArbMain(ByVal Num As String, ByVal sMinCurrency As String, ByVal sSubCurrency As String) As String
        'áíÔãá ÇáÌÒÁ ÇáÚÔÑí æÇÙåÇÑ ÇÓã ÇáÚãáÉ  ASMSA æÊäÞíÍ ãä KARIMSOFT åÐÇ ÇáÇÌÑÇÁ Êã ÇÖÇÝÊÉ ãä ÞÈá
        Dim qwq() As String, s As String
        qwq = Num.Split(".")
        If Not qwq Is Nothing Then
         If qwq.Length > 1 Then _
                s = ToWordsArb(qwq(0)) & " " & sMinCurrency & " æ " & ToWordsArb(qwq(1)) & " " & sSubCurrency
        End If
        If s = "" Then ToWordsArbMain = ToWordsArb(Num) & " " & sMinCurrency Else ToWordsArbMain = s
    End Function
    Function ToWordsArb(ByVal Num As String) As String
        'ßæÏ ÇáÊÝÞíØ ÇáÇÓÇÓí
        Dim Tmp As String, X As String
        Dim L As Integer, T As Integer, T_ As String
        Const s As String = " ": Const o As String = " æ "
        T_ = "ÇáÇÝ"


        'Fill Array'''''''''''''''''''(1 to 9)'''''''''''''''''''''
        Dim AN(9) As String 'Data for conversion
        AN(1) = "æÇÍÏ": AN(2) = "ÇËäÇä": AN(3) = "ËáÇËÉ"
        AN(4) = "ÇÑÈÚÉ": AN(5) = "ÎãÓÉ": AN(6) = "ÓÊÉ"
        AN(7) = "ÓÈÚÉ": AN(8) = "ËãÇäíÉ": AN(9) = "ÊÓÚÉ"
        ''''''''''''''''''''(11 to 19 )'''''''''''''''''''''''''''''
        Dim BN(9) As String
        BN(0) = "ÚÔÑÉ"
        BN(1) = "ÇÍÏ ÚÔÑ": BN(2) = "ÇËäÇ ÚÔÑ": BN(3) = "ËáÇËÉ ÚÔÑ"
        BN(4) = "ÇÑÈÚ ÚÔÑ": BN(5) = "ÎãÓÉ ÚÔÑ": BN(6) = "ÓÊÉ ÚÔÑ"
        BN(7) = "ÓÈÚÉ ÚÔÑ": BN(8) = "ËãÇäíÉ ÚÔÑ": BN(9) = "ÊÓÚÉ ÚÔÑ"
        ''''''''''''''''''''(10 to 90)'''''''''''''''''''''''''''''''''''
        Dim CN(9) As String
        CN(1) = "ÚÔÑÉ": CN(2) = "ÚÔÑíä": CN(3) = "ËáÇËíä"
        CN(4) = "ÇÑÈÚíä": CN(5) = "ÎãÓíä": CN(6) = "ÓÊíä"
        CN(7) = "ÓÈÚíä": CN(8) = "ËãÇäíä": CN(9) = "ÊÓÚíä"
        ''''''''''''''''''''(100 to 900)'''''''''''''''''''''''''''''''''''
        Dim DN(9) As String
        DN(1) = "ãÇÆÉ": DN(2) = "ãÇÆÊíä": DN(3) = "ËáÇË ãÇÆÉ"
        DN(4) = "ÇÑÈÚ ãÇÆÉ": DN(5) = "ÎãÓ ãÇÆÉ": DN(6) = "ÓÊ ãÇÆÉ"
        DN(7) = "ÓÈÚ ãÇÆÉ": DN(8) = "ËãÇä ãÇÆÉ": DN(9) = "ÊÓÚ ãÇÆÉ"
        'ZEROs''''''''''''''''''''''''''''''
        AN(0) = "": BN(0) = "ÚÔÑÉ": CN(0) = "": DN(0) = ""
        'Make redey''''''''''''''''''''''''''''''

        L = Len(Num)

        '''''''''''''''''''''''''''''''''Check Start: ''''''''''''''''''''''''''''''''''''''''''''
        ''ALL BY ORDER :'''''''''''''''''''''''''''''

        Dim W As Collection, C As Integer, MM As String
        W = New Collection
        'Split numbers to array
        For T = L To 1 Step -1
            MM = Mid(CStr(Num), T, 1)
            If IsNumeric(MM) Then W.Add (MM)
        Next T
        'Exit if it Zero'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Num = Replace(Num, "|", ""): If Val(Num) = 0 Then X = "ÕÝÑ": GoTo Ex   '
        C = W.count: L = C  'Very Important                                    '
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        '1 Check''1 to 9
        If L = 1 Then X = AN(Val(Num)): GoTo Ex

        '2 Check'11-12-13....To: 19
        If L = 2 Then If Val(W.Item(2)) = 1 Then _
        X = BN(Val(W.Item(1))): GoTo Ex

        '2 Check'10-20-30....To: 90
        If L = 2 Then If Val(W.Item(1)) = 0 Then _
        X = CN(Val(W.Item(2))): GoTo Ex

        '3 Check'From 21 ....To: 90
        If L = 2 Then X = AN(Val(W.Item(1))) & o & CN(Val(W.Item(2))): GoTo Ex

Re_Check:
        '3 Check' The Tow First Numbers of Large number:
        If Val(W.Item(2)) = "1" Then 'Elvenths(BN)
            X = BN(Val(Val(W.Item(1))))
        ElseIf Val(W.Item(1)) = "0" Then 'Twentieth(CN)
            X = CN(Val(Val(W.Item(2))))
        Else
            X = AN(Val(W.Item(1))) & o & CN(Val(W.Item(2)))  'From 21-67 ....To: 90
        End If

        X = Zeros(W, X, 2)

        '4 Check ' 12-31-41... to end'''

        If L > 2 Then 'Hundreds(DN)
            X = DN(Val(W.Item(3))) & o & X 'Hundreds & Numbers
            If W.Item(1) = "0" And W.Item(2) = "0" Then X = DN(Val(W.Item(3))) 'Hundreds & Zeros

            X = Zeros(W, X, 3)
        End If
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Thawsend(1,000)''4 Numbers'''''''''''''''''''''''''''''''
        If L < 4 Then GoTo Ex

        If Val(W.Item(4)) < 1 Then GoTo TenThousand 'Jump
        If L > 4 Then If Val(W.Item(5)) <> 0 Then GoTo TenThousand 'Jump
        If L > 5 Then If Val(W(6)) <> 0 Then GoTo TenThousand 'Jump

        Tmp = MofradMothan(Val(W.Item(4)), "ÇáÝ", "ÇáÝíä", "ÇáÇÝ")

        X = Zeros(W, X, 4)
        If Val(W.Item(4)) > 2 Then X = AN(Val(W(4))) & s & Tmp & o & X Else X = Tmp & o & X
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'If L > 4 And L < 8 Then '10 Thawsend(10,000)''5 Numbers'''''''''''''''''''''''''''''''
        If L > 4 Then ''___ OPEN IF ______________________________________________(L > 4)

TenThousand:  '10 Thawsend(10,000)''5 Numbers'''''''''''''''''''''''''''''''
            Tmp = ""
            If W(5) = "0" Then GoTo HoundredsThawsend 'Jump

            Tmp = MofradMothan(Val(Val(W.Item(5))), "ÚÔÑÉ ÇáÇÝ", "ÚÔÑíä ÇáÝ")

            If W(4) = "0" Then '10.000
                If Val(W.Item(5)) = 1 Or Val(W.Item(5)) = 2 Then X = Tmp & o & X Else _
                T_ = "ÇáÝ": X = CN(Val(W(5))) & s & T_ & o & X
            Else '11.000
                T_ = "ÇáÝ"
                If W(5) = "1" Then X = BN(Val(W(4))) & s & T_ & o & X
                If W(5) <> "1" Then X = AN(Val(W(4))) & o & CN(Val(W(5))) & s & T_ & o & X
            End If

            If L = 5 Then GoTo Ex '100 Thawsend(100,000)''6 Numbers''''''''''''''''''''''''''''''
HoundredsThawsend:

            If W(6) = "0" Then GoTo Mileons 'Jump
            X = Zeros(W, X, 5)

            Tmp = "ÇáÝ"

            If W(5) = "0" And W(4) = "0" Then
                X = DN(Val(W(6))) & s & Tmp & o & X
            Else
                If W(5) = 0 Then
                    If Val(W(6)) > 2 Then Tmp = "ÇáÇÝ"
                    If Val(W(5)) = 0 Then If Val(W(4)) > 2 Then Tmp = "ÇáÇÝ" Else Tmp = "ÇáÝ"
                    X = DN(Val(W(6))) & o & AN(Val(W(4))) & s & Tmp & o & X 'tx here
                Else
                    X = DN(Val(W(6))) & o & X
                End If
            End If
            X = Replace(X, "ãÇÆÊíä ÇáÝ", "ãÆÊí ÇáÝ")
            X = Replace(X, " ÇáÝ ÇáÝ ", " ÇáÝ ")

            If L < 7 Then GoTo Ex 'Milon(1000,000)''7 numbers'''''''''''''''''''''''''''''''
Mileons:

            If Val(W.Item(7)) < 1 Then GoTo TenMileons 'Jump
            If L > 7 Then If Val(W.Item(8)) <> 0 Then GoTo TenMileons 'Jump
            If L > 8 Then If Val(W(9)) <> 0 Then GoTo TenMileons 'Jump

            Tmp = MofradMothan(Val(W.Item(7)), "ãáíæä", "ãáíæäíä", "ãáÇíä")

            X = Zeros(W, X, 6)

            If Val(W.Item(7)) > 2 Then X = AN(Val(W(7))) & s & Tmp & o & X Else X = Tmp & o & X

            If L < 8 Then GoTo Ex 'Ten of Milons(10,000,000)''8 numbers'''''''''''''''''''''''''''''''
TenMileons:
            If L > 8 Then If Val(W(9)) <> 0 Or Val(W(8)) < 1 Then GoTo HoundredsMileons 'Jump

            If Val(W(8)) = 1 Then Tmp = "ãáÇíä" Else Tmp = "ãáíæä"

            X = Zeros(W, X, 6)
            X = Zeros(W, X, 7)

            If Val(W(8)) = 1 Then 'Ten of Mileons:10,000,000
                If Val(W(7)) = 0 Then X = CN(Val(W(8))) & s & Tmp & o & X Else _
                Tmp = "ãáíæä": X = BN(Val(W(7))) & s & Tmp & o & X  'Elventh Mileons
            Else
                If Val(W(7)) = 0 Then X = CN(Val(W(8))) & s & Tmp & o & X Else _
                 X = AN(Val(W(7))) & o & CN(Val(W(8))) & s & Tmp & o & X '12,000,000
            End If

            If L < 9 Then GoTo Ex 'Houndreds of Milon(100,000,000)''9 numbers'''''''''''''''''''''''''''''''
HoundredsMileons:
            If L > 9 And Val(W(9)) < 1 Then GoTo Bileon

            Tmp = "ãáíæä"
            X = Zeros(W, X, 8)

            If Val(W(7)) = 0 And Val(W(8)) = 0 Then    '100,000,000
                X = DN(Val(W(9))) & s & Tmp & o & X 'Puer Houndreds Of Mileons
            Else '110,000,000
                '1- Houndreds Of Mileons & Elvenths : ..2- Else :Houndreds Of Mileons & Frist numbers
                If Val(W(8)) = 1 Then X = DN(Val(W(9))) & o & BN(Val(W(7))) & s & Tmp & o & X Else _
                X = DN(Val(W(9))) & o & AN(Val(W(7))) & s & o & CN(Val(W(8))) & s & Tmp & o & X
            End If
            X = Replace(X, "ãÇÆÊíä ãáíæä", "ãÆÊí ãáíæä")

            If L < 10 Then GoTo Ex 'Bileon(1,000,000,000)''10 numbers'''''''''''''''''''''''''''''''
Bileon:

            If Val(W.Item(10)) < 1 Then GoTo Ten_Of_Bileons 'Jump
            If L > 10 Then If Val(W.Item(11)) <> 0 Then GoTo Ten_Of_Bileons 'Jump
            If L > 11 Then If Val(W(12)) <> 0 Then GoTo Ten_Of_Bileons 'Jump

            Tmp = MofradMothan(Val(W.Item(10)), "Èáíæä", "Èáíæäíä", "ÈáÇíä")


            X = Zeros(W, X, 9)

            If Val(W.Item(10)) > 2 Then X = AN(Val(W(10))) & s & Tmp & o & X Else X = Tmp & o & X

            If L < 11 Then GoTo Ex 'Bileon(10,000,000,000)''11 numbers'''''''''''''''''''''''''''''''
Ten_Of_Bileons:

            If L > 11 Then If Val(W(12)) <> 0 Or Val(W(11)) < 1 Then GoTo Houndred_Of_Bileons 'Jump

            If Val(W(11)) = 1 Then Tmp = "ÈáÇíä" Else Tmp = "Èáíæä"

            X = Zeros(W, X, 11)

            If Val(W(11)) = 1 Then 'Tenth Bileons:10,000,000,000
                If Val(W(10)) = 0 Then X = CN(Val(W(11))) & s & Tmp & o & X Else _
                Tmp = "Èáíæä": X = BN(Val(W(10))) & s & Tmp & o & X  'Elventh Bileons
            Else
                If Val(W(10)) = 0 Then X = CN(Val(W(11))) & s & Tmp & o & X Else _
                 X = AN(Val(W(10))) & o & CN(Val(W(11))) & s & Tmp & o & X '12,000,000,000
            End If

            If L < 12 Then GoTo Ex 'Bileon(100,000,000,000)''12 numbers'''''''''''''''''''''''''''''''
Houndred_Of_Bileons:
            If L > 12 And Val(W(12)) < 1 Then GoTo Trlion

            Tmp = "Èáíæä"
            X = Zeros(W, X, 12)

            If Val(W(10)) = 0 And Val(W(11)) = 0 Then    '100,000,000,000
                X = DN(Val(W(12))) & s & Tmp & o & X 'Puer Houndreds Of Bileons
            Else '110,000,000,000
                '1- Houndreds Of Bileons & Elvenths : ..2- Else :Houndreds Of Bileons & Frist numbers
                If Val(W(11)) = 1 Then X = DN(Val(W(12))) & o & BN(Val(W(10))) & s & Tmp & o & X Else _
                X = DN(Val(W(12))) & o & AN(Val(W(10))) & s & o & CN(Val(W(11))) & s & Tmp & o & X
            End If

            X = Replace(X, "ãÇÆÊíä Èáíæä", "ãÆÊí Èáíæä")

            If L < 13 Then GoTo Ex 'Trlion(1,000,000,000,000)''13 numbers'''''''''''''''''''''''''''''''
Trlion:

            If Val(W.Item(13)) < 1 Then GoTo Ten_Of_Trlions 'Jump
            If L > 13 Then If Val(W.Item(14)) <> 0 Then GoTo Ten_Of_Trlions 'Jump
            If L > 14 Then If Val(W.Item(15)) <> 0 Then GoTo Ten_Of_Trlions 'Jump

            Tmp = MofradMothan(Val(W.Item(13)), "ÊÑáíæä", "ÊÑáíæäíä", "ÊÑíáæäÇÊ")

            X = Zeros(W, X, 13)
            If Val(W.Item(13)) > 2 Then X = AN(Val(W(13))) & s & Tmp & o & X Else X = Tmp & o & X

            If L < 14 Then GoTo Ex 'Ten_Of_Trlions(10,000,000,000,000)''14 numbers'''''''''''''''''''''''''''''''
Ten_Of_Trlions:

            If L > 14 Then If Val(W(15)) <> 0 Or Val(W(14)) < 1 Then GoTo Houndreds_Of_Trlions 'Jump

            If Val(W(14)) = 1 Then Tmp = "ÊÑíáæäÇÊ" Else Tmp = "ÊÑáíæä"

            X = Zeros(W, X, 14)

            If Val(W(14)) = 1 Then 'Tenth Trlions:10,000,000,000,000
                If Val(W(13)) = 0 Then X = CN(Val(W(14))) & s & Tmp & o & X Else _
                Tmp = "ÊÑáíæä": X = BN(Val(W(13))) & s & Tmp & o & X  'Elventh Trlions
            Else
                If Val(W(13)) = 0 Then X = CN(Val(W(14))) & s & Tmp & o & X Else _
                 X = AN(Val(W(13))) & o & CN(Val(W(14))) & s & Tmp & o & X '12,000,000,000,000
            End If

            If L < 15 Then GoTo Ex 'Houndreds_Of_Trlions(100,000,000,000,000)''15 numbers'''''''''''''''''''''''''''''''
Houndreds_Of_Trlions:
            If L > 15 And Val(W(15)) < 1 Then GoTo Quadrillion

            Tmp = "ÊÑáíæä"
            X = Zeros(W, X, 15)

            If Val(W(13)) = 0 And Val(W(14)) = 0 Then    '100,000,000,000,000
                X = DN(Val(W(15))) & s & Tmp & o & X 'Puer Houndreds Of Trlions
            Else '110,000,000,000,000
                '1- Houndreds Of Trlions & Elvenths : ..2- Else :Houndreds Of Trlions & Frist numbers
                If Val(W(14)) = 1 Then X = DN(Val(W(15))) & o & BN(Val(W(13))) & s & Tmp & o & X Else _
                X = DN(Val(W(15))) & o & AN(Val(W(13))) & s & o & CN(Val(W(14))) & s & Tmp & o & X
            End If

            X = Replace(X, "ãÇÆÊíä ÊÑáíæä", "ãÆÊí ÊÑáíæä")

            If L < 16 Then GoTo Ex 'Quadrillion(1,000,000,000,000,000)''16 numbers'''''''''''''''''''''''''''''''
Quadrillion:

            If Val(W.Item(16)) < 1 Then GoTo Ten_Of_Quadrillions 'Jump
            If L > 16 Then If Val(W.Item(17)) <> 0 Then GoTo Ten_Of_Quadrillions 'Jump
            If L > 17 Then If Val(W.Item(18)) <> 0 Then GoTo Ten_Of_Quadrillions 'Jump


            Tmp = MofradMothan(Val(W.Item(16)), "ßæÇÏÑáíæä", "ßæÇÏÑáíæäíä", "ßæÇÏÑáíæäÇÊ")

            X = Zeros(W, X, 16)
            If Val(W.Item(16)) > 2 Then X = AN(Val(W(16))) & s & Tmp & o & X Else X = Tmp & o & X

            If L < 17 Then GoTo Ex 'Ten_Of_Quadrillions(10,000,000,000,000,000)''17 numbers'''''''''''''''''''''''''''''''
Ten_Of_Quadrillions:

            If L > 17 Then If Val(W(18)) <> 0 Or Val(W(17)) < 1 Then GoTo Houndreds_Of_Quadrillions 'Jump

            If Val(W(17)) = 1 Then Tmp = "ßæÇÏÑáíæäÇÊ" Else Tmp = "ßæÇÏÑáíæä"

            X = Zeros(W, X, 17)

            If Val(W(17)) = 1 Then 'Tenth Quadrillions
                If Val(W(16)) = 0 Then X = CN(Val(W(17))) & s & Tmp & o & X Else _
                Tmp = "ßæÇÏÑáíæä": X = BN(Val(W(16))) & s & Tmp & o & X  'Elventh Quadrillions
            Else
                If Val(W(16)) = 0 Then X = CN(Val(W(17))) & s & Tmp & o & X Else _
                 X = AN(Val(W(16))) & o & CN(Val(W(17))) & s & Tmp & o & X '12,000,000,000,000,000
            End If

            If L < 18 Then GoTo Ex 'Houndreds_Of_Quadrillions(100,000,000,000,000,000)''18 numbers'''''''''''''''''''''''''''''''
Houndreds_Of_Quadrillions:

            If L > 18 And Val(W(18)) < 1 Then GoTo Zlion

            Tmp = "ßæÇÏÑáíæä"
            X = Zeros(W, X, 18)

            If Val(W(16)) = 0 And Val(W(17)) = 0 Then    '100,000,000,000
                X = DN(Val(W(18))) & s & Tmp & o & X 'Pure Houndreds Of Quadrillions
            Else '110,000,000,000
                '1- Houndreds Of Quadrillions & Elvenths : ..2- Else :Houndreds Of Quadrillions & Frist numbers
                If Val(W(17)) = 1 Then X = DN(Val(W(18))) & o & BN(Val(W(16))) & s & Tmp & o & X Else _
                X = DN(Val(W(18))) & o & AN(Val(W(16))) & s & o & CN(Val(W(17))) & s & Tmp & o & X
            End If

            X = Replace(X, "ãÇÆÊíä ßæÇÏÑáíæä", "ãÆÊí ßæÇÏÑáíæä")

            If L < 19 Then GoTo Ex 'Houndreds_Of_Quadrillions(100,000,000,000,000,000)''18 numbers'''''''''''''''''''''''''''''''
Zlion:      '[The end]'''Last Naming number
            X = "": X = "Òáíæä" & vbCrLf & "ÇáÒáíæä : ÑÞã ÛíÑ ãÍÏæÏ íÝæÞ ÇáÊÓãíÇÊ ÇáãÚÑæÝÉ"

        End If ''___ CLOSE IF ______________________________________________(L > 4)
        '''''''''''''''''''''''''''''''''Check End: ''''''''''''''''''''''''''''''''''''''''''''''

Ex:
        W = Nothing
        ToWordsArbMain = X
    End Function
    Function MofradMothan(ByVal Num As Int16, ByVal Mof As String, ByVal Mot As String, Optional ByVal More As String = "") As String
        Dim r As String: r = More 'ÃßÈÑ ãä 2
        If Num = 1 Then
            r = Mof 'ãÝÑÏ
        ElseIf Num = 1 Then
            r = Mot 'ãËäì
        End If
        MofradMothan = r
    End Function

    Function Zeros(ByVal Col As Collection, ByVal X As String, ByVal MAX As Integer) As String
        Dim T As Integer, I As Boolean
        If MAX < 1 Then Zeros = "": Exit Function
        For T = 1 To Col.count
            If Val(Col.Item(T)) <> 0 Then I = True: Exit For
            If T = MAX Then Exit For
        Next T


        If I Then
            X = Trim(X)
            Dim o(1) As String
            o(0) = "æ" & Space(1): o(1) = Space(1) & "æ"
            If Left(X, 2) = o(0) Or Left(X, 2) = o(1) Then X = Mid(X, 3, Len(X))
            If Right(X, 2) = o(0) Or Left(X, 2) = o(1) Then X = Mid(X, 1, Len(X) - 2)
            Zeros = X
        Else
            Zeros = ""
        End If
    End Function

واما الكود أدناه فهو بتنسيق لمنصة فيجوال بيسك دوت نيت vb.net :

    'اما الكود هنا فهو يعمل على بئة الدوت نت اعتبارا من الاصدار 2003

    ''''''''''''''''''''''<(بداية كود التفقيط)>''''''''''''''''''''''
    Function ToWordsArbMain(ByVal NUM As String, ByVal sMinCurrency As String, ByVal sSubCurrency As String) As String
        'ليشمل الجزء العشري واظهار اسم العملة  ASMSA وتنقيح من KARIMSOFT هذا الاجراء تم اضافتة من قبل  
        Dim qwq() As String, s As String = ""

        qwq = NUM.Split(".")
        If Not qwq Is Nothing Then
            If qwq.Length > 1 Then _
               s = ToWordsArb(qwq(0)) & " " & sMinCurrency & " و " & ToWordsArb(qwq(1)) & " " & sSubCurrency
        End If

        If s = "" Then s = ToWordsArb(NUM) & " " & sMinCurrency
        Return s
    End Function
    Function ToWordsArb(ByVal Num As String) As String
        'كود التفقيط الاساسي
        Dim Tmp As String, X As String
        Dim L As Integer, T As Integer, T_ As String
        Const S As String = " " : Const O As String = " و "
        T_ = "الاف"


        'Fill Array'''''''''''''''''''(1 to 9)'''''''''''''''''''''
        Dim AN(9) As String 'Data for conversion
        AN(1) = "واحد" : AN(2) = "اثنان" : AN(3) = "ثلاثة"
        AN(4) = "اربعة" : AN(5) = "خمسة" : AN(6) = "ستة"
        AN(7) = "سبعة" : AN(8) = "ثمانية" : AN(9) = "تسعة"
        ''''''''''''''''''''(11 to 19 )'''''''''''''''''''''''''''''
        Dim BN(9) As String
        BN(0) = "عشرة"
        BN(1) = "احد عشر" : BN(2) = "اثنا عشر" : BN(3) = "ثلاثة عشر"
        BN(4) = "اربع عشر" : BN(5) = "خمسة عشر" : BN(6) = "ستة عشر"
        BN(7) = "سبعة عشر" : BN(8) = "ثمانية عشر" : BN(9) = "تسعة عشر"
        ''''''''''''''''''''(10 to 90)'''''''''''''''''''''''''''''''''''
        Dim CN(9) As String
        CN(1) = "عشرة" : CN(2) = "عشرين" : CN(3) = "ثلاثين"
        CN(4) = "اربعين" : CN(5) = "خمسين" : CN(6) = "ستين"
        CN(7) = "سبعين" : CN(8) = "ثمانين" : CN(9) = "تسعين"
        ''''''''''''''''''''(100 to 900)'''''''''''''''''''''''''''''''''''
        Dim DN(9) As String
        DN(1) = "مائة" : DN(2) = "مائتين" : DN(3) = "ثلاث مائة"
        DN(4) = "اربع مائة" : DN(5) = "خمس مائة" : DN(6) = "ست مائة"
        DN(7) = "سبع مائة" : DN(8) = "ثمان مائة" : DN(9) = "تسع مائة"
        'ZEROs''''''''''''''''''''''''''''''
        AN(0) = "" : BN(0) = "عشرة" : CN(0) = "" : DN(0) = ""
        'Make redey''''''''''''''''''''''''''''''

        L = Len(Num)

        '''''''''''''''''''''''''''''''''Check Start: ''''''''''''''''''''''''''''''''''''''''''''
        ''ALL BY ORDER :'''''''''''''''''''''''''''''

        Dim W As Collection, C As Integer, MM As String
        W = New Collection
        'Split numbers to array
        For T = L To 1 Step -1
            MM = Mid(CStr(Num), T, 1)
            If IsNumeric(MM) Then W.Add(MM)
        Next T
        'Exit if it Zero'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Num = Replace(Num, "|", "") : If Val(Num) = 0 Then X = "صفر" : GoTo Ex '
        C = W.Count : L = C 'Very Important                                    '
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        '1 Check''1 to 9
        If L = 1 Then X = AN(Val(Num)) : GoTo Ex

        '2 Check'11-12-13....To: 19
        If L = 2 Then If Val(W.Item(2)) = 1 Then _
        X = BN(Val(W.Item(1))) : GoTo Ex

        '2 Check'10-20-30....To: 90
        If L = 2 Then If Val(W.Item(1)) = 0 Then _
        X = CN(Val(W.Item(2))) : GoTo Ex

        '3 Check'From 21 ....To: 90
        If L = 2 Then X = AN(Val(W.Item(1))) & O & CN(Val(W.Item(2))) : GoTo Ex

Re_Check:
        '3 Check' The Tow First Numbers of Large number:
        If Val(W.Item(2)) = "1" Then 'Elvenths(BN)
            X = BN(Val(Val(W.Item(1))))
        ElseIf Val(W.Item(1)) = "0" Then 'Twentieth(CN)
            X = CN(Val(Val(W.Item(2))))
        Else
            X = AN(Val(W.Item(1))) & O & CN(Val(W.Item(2)))  'From 21-67 ....To: 90
        End If

        X = Zeros(W, X, 2)

        '4 Check ' 12-31-41... to end'''

        If L > 2 Then 'Hundreds(DN)
            X = DN(Val(W.Item(3))) & O & X 'Hundreds & Numbers
            If W.Item(1) = "0" And W.Item(2) = "0" Then X = DN(Val(W.Item(3))) 'Hundreds & Zeros

            X = Zeros(W, X, 3)
        End If
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Thawsend(1,000)''4 Numbers'''''''''''''''''''''''''''''''
        If L < 4 Then GoTo Ex

        If Val(W.Item(4)) < 1 Then GoTo TenThousand 'Jump
        If L > 4 Then If Val(W.Item(5)) <> 0 Then GoTo TenThousand 'Jump
        If L > 5 Then If Val(W(6)) <> 0 Then GoTo TenThousand 'Jump

        Tmp = MofradMothan(Val(W.Item(4)), "الف", "الفين", "الاف")

        X = Zeros(W, X, 4)
        If Val(W.Item(4)) > 2 Then X = AN(Val(W(4))) & S & Tmp & O & X Else X = Tmp & O & X
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'If L > 4 And L < 8 Then '10 Thawsend(10,000)''5 Numbers'''''''''''''''''''''''''''''''
        If L > 4 Then ''___ OPEN IF ______________________________________________(L > 4)

TenThousand:  '10 Thawsend(10,000)''5 Numbers'''''''''''''''''''''''''''''''
            Tmp = ""
            If W(5) = "0" Then GoTo HoundredsThawsend 'Jump

            Tmp = MofradMothan(Val(Val(W.Item(5))), "عشرة الاف", "عشرين الف", )

            If W(4) = "0" Then '10.000
                If Val(W.Item(5)) = 1 Or Val(W.Item(5)) = 2 Then X = Tmp & O & X Else _
                T_ = "الف" : X = CN(Val(W(5))) & S & T_ & O & X
            Else '11.000
                T_ = "الف"
                If W(5) = "1" Then X = BN(Val(W(4))) & S & T_ & O & X
                If W(5) <> "1" Then X = AN(Val(W(4))) & O & CN(Val(W(5))) & S & T_ & O & X
            End If

            If L = 5 Then GoTo Ex '100 Thawsend(100,000)''6 Numbers''''''''''''''''''''''''''''''
HoundredsThawsend:

            If W(6) = "0" Then GoTo Mileons 'Jump
            X = Zeros(W, X, 5)

            Tmp = "الف"

            If W(5) = "0" And W(4) = "0" Then
                X = DN(Val(W(6))) & S & Tmp & O & X
            Else
                If W(5) = 0 Then
                    If Val(W(6)) > 2 Then Tmp = "الاف"
                    If Val(W(5)) = 0 Then If Val(W(4)) > 2 Then Tmp = "الاف" Else Tmp = "الف"
                    X = DN(Val(W(6))) & O & AN(Val(W(4))) & S & Tmp & O & X 'tx here
                Else
                    X = DN(Val(W(6))) & O & X
                End If
            End If
            X = Replace(X, "مائتين الف", "مئتي الف")
            X = Replace(X, " الف الف ", " الف ")

            If L < 7 Then GoTo Ex 'Milon(1000,000)''7 numbers'''''''''''''''''''''''''''''''
Mileons:

            If Val(W.Item(7)) < 1 Then GoTo TenMileons 'Jump
            If L > 7 Then If Val(W.Item(8)) <> 0 Then GoTo TenMileons 'Jump
            If L > 8 Then If Val(W(9)) <> 0 Then GoTo TenMileons 'Jump

            Tmp = MofradMothan(Val(W.Item(7)), "مليون", "مليونين", "ملاين")

            X = Zeros(W, X, 6)

            If Val(W.Item(7)) > 2 Then X = AN(Val(W(7))) & S & Tmp & O & X Else X = Tmp & O & X

            If L < 8 Then GoTo Ex 'Ten of Milons(10,000,000)''8 numbers'''''''''''''''''''''''''''''''
TenMileons:
            If L > 8 Then If Val(W(9)) <> 0 Or Val(W(8)) < 1 Then GoTo HoundredsMileons 'Jump

            If Val(W(8)) = 1 Then Tmp = "ملاين" Else Tmp = "مليون"

            X = Zeros(W, X, 6)
            X = Zeros(W, X, 7)

            If Val(W(8)) = 1 Then 'Ten of Mileons:10,000,000
                If Val(W(7)) = 0 Then X = CN(Val(W(8))) & S & Tmp & O & X Else _
                Tmp = "مليون" : X = BN(Val(W(7))) & S & Tmp & O & X 'Elventh Mileons
            Else
                If Val(W(7)) = 0 Then X = CN(Val(W(8))) & S & Tmp & O & X Else _
                 X = AN(Val(W(7))) & O & CN(Val(W(8))) & S & Tmp & O & X '12,000,000
            End If

            If L < 9 Then GoTo Ex 'Houndreds of Milon(100,000,000)''9 numbers'''''''''''''''''''''''''''''''
HoundredsMileons:
            If L > 9 And Val(W(9)) < 1 Then GoTo Bileon

            Tmp = "مليون"
            X = Zeros(W, X, 8)

            If Val(W(7)) = 0 And Val(W(8)) = 0 Then    '100,000,000
                X = DN(Val(W(9))) & S & Tmp & O & X 'Puer Houndreds Of Mileons
            Else '110,000,000
                '1- Houndreds Of Mileons & Elvenths : ..2- Else :Houndreds Of Mileons & Frist numbers
                If Val(W(8)) = 1 Then X = DN(Val(W(9))) & O & BN(Val(W(7))) & S & Tmp & O & X Else _
                X = DN(Val(W(9))) & O & AN(Val(W(7))) & S & O & CN(Val(W(8))) & S & Tmp & O & X
            End If
            X = Replace(X, "مائتين مليون", "مئتي مليون")

            If L < 10 Then GoTo Ex 'Bileon(1,000,000,000)''10 numbers'''''''''''''''''''''''''''''''
Bileon:

            If Val(W.Item(10)) < 1 Then GoTo Ten_Of_Bileons 'Jump
            If L > 10 Then If Val(W.Item(11)) <> 0 Then GoTo Ten_Of_Bileons 'Jump
            If L > 11 Then If Val(W(12)) <> 0 Then GoTo Ten_Of_Bileons 'Jump

            Tmp = MofradMothan(Val(W.Item(10)), "بليون", "بليونين", "بلاين")


            X = Zeros(W, X, 9)

            If Val(W.Item(10)) > 2 Then X = AN(Val(W(10))) & S & Tmp & O & X Else X = Tmp & O & X

            If L < 11 Then GoTo Ex 'Bileon(10,000,000,000)''11 numbers'''''''''''''''''''''''''''''''
Ten_Of_Bileons:

            If L > 11 Then If Val(W(12)) <> 0 Or Val(W(11)) < 1 Then GoTo Houndred_Of_Bileons 'Jump

            If Val(W(11)) = 1 Then Tmp = "بلاين" Else Tmp = "بليون"

            X = Zeros(W, X, 11)

            If Val(W(11)) = 1 Then 'Tenth Bileons:10,000,000,000
                If Val(W(10)) = 0 Then X = CN(Val(W(11))) & S & Tmp & O & X Else _
                Tmp = "بليون" : X = BN(Val(W(10))) & S & Tmp & O & X 'Elventh Bileons
            Else
                If Val(W(10)) = 0 Then X = CN(Val(W(11))) & S & Tmp & O & X Else _
                 X = AN(Val(W(10))) & O & CN(Val(W(11))) & S & Tmp & O & X '12,000,000,000
            End If

            If L < 12 Then GoTo Ex 'Bileon(100,000,000,000)''12 numbers'''''''''''''''''''''''''''''''
Houndred_Of_Bileons:
            If L > 12 And Val(W(12)) < 1 Then GoTo Trlion

            Tmp = "بليون"
            X = Zeros(W, X, 12)

            If Val(W(10)) = 0 And Val(W(11)) = 0 Then    '100,000,000,000
                X = DN(Val(W(12))) & S & Tmp & O & X 'Puer Houndreds Of Bileons
            Else '110,000,000,000
                '1- Houndreds Of Bileons & Elvenths : ..2- Else :Houndreds Of Bileons & Frist numbers
                If Val(W(11)) = 1 Then X = DN(Val(W(12))) & O & BN(Val(W(10))) & S & Tmp & O & X Else _
                X = DN(Val(W(12))) & O & AN(Val(W(10))) & S & O & CN(Val(W(11))) & S & Tmp & O & X
            End If

            X = Replace(X, "مائتين بليون", "مئتي بليون")

            If L < 13 Then GoTo Ex 'Trlion(1,000,000,000,000)''13 numbers'''''''''''''''''''''''''''''''
Trlion:

            If Val(W.Item(13)) < 1 Then GoTo Ten_Of_Trlions 'Jump
            If L > 13 Then If Val(W.Item(14)) <> 0 Then GoTo Ten_Of_Trlions 'Jump
            If L > 14 Then If Val(W.Item(15)) <> 0 Then GoTo Ten_Of_Trlions 'Jump

            Tmp = MofradMothan(Val(W.Item(13)), "ترليون", "ترليونين", "تريلونات")

            X = Zeros(W, X, 13)
            If Val(W.Item(13)) > 2 Then X = AN(Val(W(13))) & S & Tmp & O & X Else X = Tmp & O & X

            If L < 14 Then GoTo Ex 'Ten_Of_Trlions(10,000,000,000,000)''14 numbers'''''''''''''''''''''''''''''''
Ten_Of_Trlions:

            If L > 14 Then If Val(W(15)) <> 0 Or Val(W(14)) < 1 Then GoTo Houndreds_Of_Trlions 'Jump

            If Val(W(14)) = 1 Then Tmp = "تريلونات" Else Tmp = "ترليون"

            X = Zeros(W, X, 14)

            If Val(W(14)) = 1 Then 'Tenth Trlions:10,000,000,000,000
                If Val(W(13)) = 0 Then X = CN(Val(W(14))) & S & Tmp & O & X Else _
                Tmp = "ترليون" : X = BN(Val(W(13))) & S & Tmp & O & X 'Elventh Trlions
            Else
                If Val(W(13)) = 0 Then X = CN(Val(W(14))) & S & Tmp & O & X Else _
                 X = AN(Val(W(13))) & O & CN(Val(W(14))) & S & Tmp & O & X '12,000,000,000,000
            End If

            If L < 15 Then GoTo Ex 'Houndreds_Of_Trlions(100,000,000,000,000)''15 numbers'''''''''''''''''''''''''''''''
Houndreds_Of_Trlions:
            If L > 15 And Val(W(15)) < 1 Then GoTo Quadrillion

            Tmp = "ترليون"
            X = Zeros(W, X, 15)

            If Val(W(13)) = 0 And Val(W(14)) = 0 Then    '100,000,000,000,000
                X = DN(Val(W(15))) & S & Tmp & O & X 'Puer Houndreds Of Trlions
            Else '110,000,000,000,000
                '1- Houndreds Of Trlions & Elvenths : ..2- Else :Houndreds Of Trlions & Frist numbers
                If Val(W(14)) = 1 Then X = DN(Val(W(15))) & O & BN(Val(W(13))) & S & Tmp & O & X Else _
                X = DN(Val(W(15))) & O & AN(Val(W(13))) & S & O & CN(Val(W(14))) & S & Tmp & O & X
            End If

            X = Replace(X, "مائتين ترليون", "مئتي ترليون")

            If L < 16 Then GoTo Ex 'Quadrillion(1,000,000,000,000,000)''16 numbers'''''''''''''''''''''''''''''''
Quadrillion:

            If Val(W.Item(16)) < 1 Then GoTo Ten_Of_Quadrillions 'Jump
            If L > 16 Then If Val(W.Item(17)) <> 0 Then GoTo Ten_Of_Quadrillions 'Jump
            If L > 17 Then If Val(W.Item(18)) <> 0 Then GoTo Ten_Of_Quadrillions 'Jump


            Tmp = MofradMothan(Val(W.Item(16)), "كوادرليون", "كوادرليونين", "كوادرليونات")

            X = Zeros(W, X, 16)
            If Val(W.Item(16)) > 2 Then X = AN(Val(W(16))) & S & Tmp & O & X Else X = Tmp & O & X

            If L < 17 Then GoTo Ex 'Ten_Of_Quadrillions(10,000,000,000,000,000)''17 numbers'''''''''''''''''''''''''''''''
Ten_Of_Quadrillions:

            If L > 17 Then If Val(W(18)) <> 0 Or Val(W(17)) < 1 Then GoTo Houndreds_Of_Quadrillions 'Jump

            If Val(W(17)) = 1 Then Tmp = "كوادرليونات" Else Tmp = "كوادرليون"

            X = Zeros(W, X, 17)

            If Val(W(17)) = 1 Then 'Tenth Quadrillions
                If Val(W(16)) = 0 Then X = CN(Val(W(17))) & S & Tmp & O & X Else _
                Tmp = "كوادرليون" : X = BN(Val(W(16))) & S & Tmp & O & X 'Elventh Quadrillions
            Else
                If Val(W(16)) = 0 Then X = CN(Val(W(17))) & S & Tmp & O & X Else _
                 X = AN(Val(W(16))) & O & CN(Val(W(17))) & S & Tmp & O & X '12,000,000,000,000,000
            End If

            If L < 18 Then GoTo Ex 'Houndreds_Of_Quadrillions(100,000,000,000,000,000)''18 numbers'''''''''''''''''''''''''''''''
Houndreds_Of_Quadrillions:

            If L > 18 And Val(W(18)) < 1 Then GoTo Zlion

            Tmp = "كوادرليون"
            X = Zeros(W, X, 18)

            If Val(W(16)) = 0 And Val(W(17)) = 0 Then    '100,000,000,000
                X = DN(Val(W(18))) & S & Tmp & O & X 'Pure Houndreds Of Quadrillions
            Else '110,000,000,000
                '1- Houndreds Of Quadrillions & Elvenths : ..2- Else :Houndreds Of Quadrillions & Frist numbers
                If Val(W(17)) = 1 Then X = DN(Val(W(18))) & O & BN(Val(W(16))) & S & Tmp & O & X Else _
                X = DN(Val(W(18))) & O & AN(Val(W(16))) & S & O & CN(Val(W(17))) & S & Tmp & O & X
            End If

            X = Replace(X, "مائتين كوادرليون", "مئتي كوادرليون")

            If L < 19 Then GoTo Ex 'Houndreds_Of_Quadrillions(100,000,000,000,000,000)''18 numbers'''''''''''''''''''''''''''''''
Zlion:      '[The end]'''Last Naming number
            X = "" : X = "زليون" & vbCrLf & "الزليون : رقم غير محدود يفوق التسميات المعروفة"

        End If ''___ CLOSE IF ______________________________________________(L > 4)
        '''''''''''''''''''''''''''''''''Check End: ''''''''''''''''''''''''''''''''''''''''''''''

Ex:
        W = Nothing
        Return X
    End Function
    Function MofradMothan(ByVal Num As Int16, ByVal Mof As String, ByVal Mot As String, Optional ByVal More As String = "") As String
        Dim r As String = More 'أكبر من 2 
        If Num = 1 Then
            r = Mof 'مفرد
        ElseIf Num = 1 Then
            r = Mot 'مثنى
        End If
        Return r
    End Function

    Function Zeros(ByVal Col As Collection, ByVal X As String, ByVal MAX As Integer) As String
        Dim T As Integer, I As Boolean
        If MAX < 1 Then Return "" : Exit Function
        For T = 1 To Col.Count
            If Val(Col.Item(T)) <> 0 Then I = True : Exit For
            If T = MAX Then Exit For
        Next T


        If I Then
            X = Trim(X)
            Dim o(1) As String
            o(0) = "و" & Space(1) : o(1) = Space(1) & "و"
            If Left(X, 2) = o(0) Or Left(X, 2) = o(1) Then X = Mid(X, 3, Len(X))
            If Right(X, 2) = o(0) Or Right(X, 2) = o(1) Then X = Mid(X, 1, Len(X) - 2)
            Return X
        Else
            Return ""
        End If
    End Function

وأيضا هناك ملف مرفق بمشروع الكود على منصة فيجوال بيسك دوت نت ،، تجدونه أدناه

ToWordsArbCODE_New2.rar

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

ورحم الله والديك

وجعل هذا العمل في ميزان حسناتك

ودمت بخير وصحة وسلام

جاري تجربة الكود ...

عذرا عزيز

المشروع لم يفتح معي !!

اتمنى رفعه من جديد

علماً انه تم تجربة النسق EXE الذي داخل ملف bin

وما زال الخطئ موجود

أعزائي ،، الآن وبعد طول إنتظار وجدت الفرصة الملائمة وسط زحمة الأشغال ،، وبسبب كوني هذه الأيام أعمل على مشروع برمجي يتطلب كود مماثل ،،، فأني حاليا أعمل على مراجعة شاملة وتحليل لهذا الكود بهدف تطويره وصولا إلى أقصى درجات الكمال الممكنة لهذا الكود ،،،

وبأقرب فرصة بإذن الله ساطرحه بطريقة أو بأخرى.

مشكور على المجهود الرائع

جعلها الله في ميزان حساناتك ووفقك الله

لقد قمت بتجربته ياخي فعلا كود رائع جدا ومجهود مشكور عليه

اسمحلي عندي استفسار ...

في الانظمة المالية المتبعة عندنا هو عند تفقيط الرقم الي نص نقوم بتفقيط الرقم الذي قبل العلامة العشرية فقط اما الذي بعده فينزل كما هو

مثال 100.750 يكون (مائة دينار و 750 درهم )

فما هو التعديل الذي اعملة على الكود بحيث اوقف تفقيط بعد العلامة العشرية

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

الأخ العزيز ASMSA بارك الله فيك وجزاك الله عنا كل خير ووفقك لما فيه الخير.

تقبل مني اخي العزيز جزيل الشكر والتقدير لمجهودك الرائع ، وكذلك الشكر موصول لكل من ساهم ونقح هذا الكود.

وجزاكم الله عنا كل خير.

مشكوووووووووووووووووووووووووووووور أخي الكريم انجاز رائع في حق البرمجة ، فكرة مبدعة حقاً ..

اتمنى لك المزيد من التوفيق والسداد في الرؤية ( :

مشكور على المجهود الكبير.

أنا عملت نفس الفكرة في السابق وأحذت مني مجهود ووقت كبير جداً لذلك فعلاً أقدر التعب الذي قمت به.

ألف شكر

مشكور أخي الكريم عل هذا الجهد الكبير

تعبك تجزى عليه من الله إن شاء الله

مع تحياتي