كود يقوم بتحويل الارقام الى نصوص

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

Public Function Horof(X) 
Ma = " ريال" 
Mi = " هللة" 
N = Int(X) 
B = Val(Right(Format(X, "000000000000.00"), 2)) 
R = SHorof(N) 
If R <> "" And B > 0 Then Result = R & Ma & " و " & B & Mi 
If R <> "" And B = 0 Then Result = R & Ma 
If R = "" And B <> 0 Then Result = B & Mi 
Horof = Result 

End Function 
Private Function SHorof(X) 

N = Int(X) 
C = Format(N, "000000000000") 
C1 = Val(Mid(C, 12, 1)) 
Select Case C1 
Case Is = 1: Letter1 = "واحد" 
Case Is = 2: Letter1 = "اثنان" 
Case Is = 3: Letter1 = "ثلاثة" 
Case Is = 4: Letter1 = "اربعة" 
Case Is = 5: Letter1 = "خمسة" 
Case Is = 6: Letter1 = "ستة" 
Case Is = 7: Letter1 = "سبعة" 
Case Is = 8: Letter1 = "ثمانية" 
Case Is = 9: Letter1 = "تسعة" 
End Select 

C2 = Val(Mid(C, 11, 1)) 
Select Case C2 
Case Is = 1: Letter2 = "عشر" 
Case Is = 2: Letter2 = "عشرون" 
Case Is = 3: Letter2 = "ثلاثون" 
Case Is = 4: Letter2 = "اربعون" 
Case Is = 5: Letter2 = "خمسون" 
Case Is = 6: Letter2 = "ستون" 
Case Is = 7: Letter2 = "سبعون" 
Case Is = 8: Letter2 = "ثمانون" 
Case Is = 9: Letter2 = "تسعون" 
End Select 

If Letter1 <> "" And C2 > 1 Then Letter2 = Letter1 + " و" + Letter2 
If Letter2 = "" Then Letter2 = Letter1 
If C1 = 0 And C2 = 1 Then Letter2 = Letter2 + "ة" 
If C1 = 1 And C2 = 1 Then Letter2 = "احدى عشر" 
If C1 = 2 And C2 = 1 Then Letter2 = "اثنى عشر" 
If C1 > 2 And C2 = 1 Then Letter2 = Letter1 + " " + Letter2 
C3 = Val(Mid(C, 10, 1)) 
Select Case C3 
Case Is = 1: Letter3 = "مائة" 
Case Is = 2: Letter3 = "مئتان" 
Case Is > 2: Letter3 = Left(SHorof(C3), Len(SHorof(C3)) - 1) + "مائة" 
End Select 
If Letter3 <> "" And Letter2 <> "" Then Letter3 = Letter3 + " و" + Letter2 
If Letter3 = "" Then Letter3 = Letter2 

C4 = Val(Mid(C, 7, 3)) 
Select Case C4 
Case Is = 1: Letter4 = "الف" 
Case Is = 2: Letter4 = "الفان" 
Case 3 To 10: Letter4 = SHorof(C4) + " آلاف" 
Case Is > 10: Letter4 = SHorof(C4) + " الف" 
End Select 
If Letter4 <> "" And Letter3 <> "" Then Letter4 = Letter4 + " و" + Letter3 
If Letter4 = "" Then Letter4 = Letter3 
C5 = Val(Mid(C, 4, 3)) 
Select Case C5 
Case Is = 1: Letter5 = "مليون" 
Case Is = 2: Letter5 = "مليونان" 
Case 3 To 10: Letter5 = SHorof(C5) + " ملايين" 
Case Is > 10: Letter5 = SHorof(C5) + " مليون" 
End Select 
If Letter5 <> "" And Letter4 <> "" Then Letter5 = Letter5 + " و" + Letter4 
If Letter5 = "" Then Letter5 = Letter4 

C6 = Val(Mid(C, 1, 3)) 
Select Case C6 
Case Is = 1: Letter6 = "مليار" 
Case Is = 2: Letter6 = "ملياران" 
Case Is > 2: Letter6 = SHorof(C6) + " مليار" 
End Select 
If Letter6 <> "" And Letter5 <> "" Then Letter6 = Letter6 + " و" + Letter5 
If Letter6 = "" Then Letter6 = Letter5 
SHorof = Letter6 

End Function

ضع هذا الكود في وحدة نمطيه عامة ثم على نموذج ضع مربع نصين الأول سمه مقدار_الراتب_رقماً والثاني مقدار_الراتب_نصاً0

وفي حدث بعد التحديث لمربع النص المسمى مقدار_الراتب_رقماً أكتب الكود التالي:

 strN = Horof(مقدار_الراتب_رقماً)
مقدار_الراتب_نصاً = strN

فعندما تكتب الرقم 4552 في الحقل المسمى مقدار_الراتب_رقماً يكون حقل مقدار الراتب نصاً كالتالي اربعة الآف وخمسمائة وإثنان وخمسون ريال

----------------------------------------------------------

المصدر :المنتدى الغالي على قلوبنا جداً جداً جداً

منتدى الفريق العربي للبرمجة " منتدى فيجول بيسك "