السلام عليكم ورحمة الله وبركاته
إخواني منذ فترة سمعت أن أحد الأخوة يحتاج هذا الكود
أضف text1 , command
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 'استخدم الكود التالي Private Sub Command1_Click() strN = Horof(Text1) MsgBox strN End Sub

