Private Sub Command4_Click()
Dim I, NN, SSS As Integer
Dim I1, I2, I3 As Integer
Dim C(9) As Integer
Dim DDD As Single
Dim AAANSS As Single
Dim NSS As Single
Dim MMSG1, MMSG2, MMSG3, MMSG4, MMSG5 As String
Dim MSG, MSG1, MSG2, MSG3 As String
Cls
MMSG1 = "": MMSG2 = "": MMSG3 = "": MSG = "": MSG1 = "": MSG2 = ""
For I = 1 To 9
C(I) = 0
Next I
NN = Len(Text1.Text)
Print "عدد الأرقام=", NN
Rem"text تعنى عدد الحروف أو الأرقام الموجود داخل هذا ال Len(Text1.Text)"
If Not IsNumeric(Text1.Text) Then Exit Sub
For I = 1 To NN
C(I) = Val(Mid(Text1.Text, NN - I + 1, 1))
Print I, C(I)
Next I
Print
Print
For J = 0 To 2
Rem"لاحظ أن ال 0 للأرقام العادية وال 1 للآلاف وال 2 للملايين"
I1 = 1 + 3 * J
If I1 > NN Then C(I1) = 0: C(I2) = 0: C(I3) = 0: MMSG1 = "": MMSG2 = "": MMSG3 = "": GoTo 100
If C(I1) = 0 Then MMSG1 = ""
If C(I1) = 1 Then MMSG1 = " وواحد"
If C(I1) = 2 Then MMSG1 = " واثنين"
If C(I1) = 3 Then MMSG1 = " وثلاثة"
If C(I1) = 4 Then MMSG1 = " وأربعة"
If C(I1) = 5 Then MMSG1 = " وخمسة"
If C(I1) = 6 Then MMSG1 = " وستة"
If C(I1) = 7 Then MMSG1 = " وسبعة"
If C(I1) = 8 Then MMSG1 = " وثمانية"
If C(I1) = 9 Then MMSG1 = " وتسعة"
I2 = 2 + 3 * J
If I2 > NN Then C(I2) = 0: C(I3) = 0: MMSG2 = "": MMSG3 = "": GoTo 100
If C(I2) = 0 Then MMSG2 = ""
If C(I2) = 1 Then
MMSG2 = "عشر"
If C(I1) = 0 Then MMSG2 = " وعشرة"
If C(I1) = 1 Then MMSG1 = " وأحد"
If C(I1) = 2 Then MMSG1 = " واثنا"
End If
Rem"تم استبدال جملة(If C(I2)= 1) بالجمل الستةالسابقة لاصلاح ال10و ال11,12"
If C(I2) = 2 Then MMSG2 = " وعشرين"
If C(I2) = 3 Then MMSG2 = " وثلاثين"
If C(I2) = 4 Then MMSG2 = " وأربعين"
If C(I2) = 5 Then MMSG2 = " وخمسين"
If C(I2) = 6 Then MMSG2 = " وستين"
If C(I2) = 7 Then MMSG2 = " وسبعين"
If C(I2) = 8 Then MMSG2 = " وثمانين"
If C(I2) = 9 Then MMSG2 = " وتسعين"
I3 = 3 + 3 * J
If I3 > NN Then C(I3) = 0: MMSG3 = "": GoTo 100
If C(I3) = 0 Then MMSG3 = ""
If C(I3) = 1 Then MMSG3 = " ومائة"
If C(I3) = 2 Then MMSG3 = " ومئتين"
If C(I3) = 3 Then MMSG3 = " وثلاثمائة"
If C(I3) = 4 Then MMSG3 = " وأربعمائة"
If C(I3) = 5 Then MMSG3 = " وخمسمائة"
If C(I3) = 6 Then MMSG3 = " وستمائة"
If C(I3) = 7 Then MMSG3 = " وسبعمائة"
If C(I3) = 8 Then MMSG3 = " وثمانمائة"
If C(I3) = 9 Then MMSG3 = " وتسعمائة"
100 If C(I1) = 0 And C(I2) = 0 And C(I3) = 0 Then GoTo 200
Rem"تم اضافة الجملة السابقة من أجل أى رقم يحتوى على ملايين بدون آلاف(مثلآ 56000978) "
If J > 0 And C(I2) = 0 And C(I3) = 0 And (C(I1) = 1 Or C(I1) = 2) Then MMSG1 = " و"
Rem"تم اضافة الجملة السابقة من أجل ال 1000 وال2000 وال1000000 وال2000000"
MSG1 = (MMSG3) + (MMSG1) + (MMSG2)
If J = 1 Then MSG2 = " ألف"
If J = 1 And C(I2) = 0 And C(I3) = 0 And C(I1) = 1 Then MSG2 = "ألف"
If J = 1 And C(I2) = 0 And C(I3) = 0 And C(I1) = 2 Then MSG2 = "ألفان"
If J = 1 And C(I2) = 0 And C(I3) = 0 And C(I1) > 2 Then MSG2 = " آلاف"
Rem"تم اضافة الجملتين قبل السابقة والشرط الأخير فى الجملةالسابقة من أجل الألف الواحدة والألفين"
If J = 1 And C(I1) = 0 And C(I2) = 1 And C(I3) = 0 Then MSG2 = " آلاف"
Rem"الجملة السابقة تعنى عشرة آلاف"
If J = 2 Then MSG2 = " مليون"
If J = 2 And C(I2) = 0 And C(I3) = 0 And C(I1) = 1 Then MSG2 = "مليون"
If J = 2 And C(I2) = 0 And C(I3) = 0 And C(I1) = 2 Then MSG2 = "مليونان"
If J = 2 And C(I2) = 0 And C(I3) = 0 And C(I1) > 2 Then MSG2 = " ملايين"
Rem"تم اضافة الجملتين قبل السابقة والشرط الأخير فى الجملةالسابقة من أجل المليون الواحدة والمليونين"
If J = 2 And C(I1) = 0 And C(I2) = 1 And C(I3) = 0 Then MSG2 = " ملايين"
Rem"الجملة السابقة تعنى عشرة ملايين"
MSG = (MSG1) + (MSG2) + (MSG)
200 If J = 0 And NN <= 3 Then GoTo 300
If J = 1 And NN <= 6 Then GoTo 300
Next J
300 MSG = Right(MSG, Len(MSG) - 2)
Rem"تم اضافة الجملةالسابقة من أجل حذف حرف الواو من بدايةالكلام(حرف الواو والفراغ السابق له)"
MMSG5 = " الرقم هو"
Z = MsgBox((MSG), vbOKOnly, (MMSG5))
End Sub