موقع المطورين
  العودة  موقع المطورين \ أقسام الأكواد والدروس \ ركن أكواد فيجويل بيسك visual Basic المجانيه \ تفقيط الارقام ( تحويل الأرقام 123 إلى مائة وثلاث وعشرون )

http://mtweren.com/bb.pngحـساباتنا البنــكيةhttp://mtweren.com/bb.png

 
 
أدوات الموضوع العرض العاديالعرض المتطورالعرض الشجري
  #1  
قديم 10-07-2017, 01:06 PM
W!ndows W!ndows غير متواجد حالياً
Administrator
 
تاريخ التسجيل: Sep 2017
المشاركات: 350
افتراضي تفقيط الارقام ( تحويل الأرقام 123 إلى مائة وثلاث وعشرون )

كود:
Public Function BADRMEDIA(X) Ma = " جنيــه" Mi = " قــرش" N = Int(X) B = Val(Right(Format(X, "000000000000.00"), 2)) R = SBADRMEDIA(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 BADRMEDIA = result End Function Private Function SBADRMEDIA(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(SBADRMEDIA(C3), Len(SBADRMEDIA(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 = SBADRMEDIA(C4) + " آلاف" Case Is > 10: Letter4 = SBADRMEDIA(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 = SBADRMEDIA(C5) + " ملايين" Case Is > 10: Letter5 = SBADRMEDIA(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 = SBADRMEDIA(C6) + " مليار" End Select If Letter6 <> "" And Letter5 <> "" Then Letter6 = Letter6 + " و" + Letter5 If Letter6 = "" Then Letter6 = Letter5 SBADRMEDIA = Letter6 End Function 4- نكتب هذا الكود فى الفورم كود : code: Private Sub Command1_Click() Dim AHMED As Single AHMED = Text1.Text StrN = BADRMEDIA(AHMED) MsgBox (AHMED) MsgBox StrN End Sub كود آخر 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 وفي الفورم strN = Horof(Text1.Text) MsgBox strN وتعتمد الفكرة باختصار على مجموعة من الشروط لقراءة الارقام وما يعادلها مكتوباً ، ومن ثم دمج الأرقام بطريقة مناسبة لتظهر مفقوطة ومكتوبة بالطريقة الصحيحة .
رد مع اقتباس


أدوات الموضوع
انواع عرض الموضوع

تعليمات المشاركة
لا تستطيع إضافة مواضيع جديدة
لا تستطيع الرد على المواضيع
لا تستطيع إرفاق ملفات
لا تستطيع تعديل مشاركاتك

BB code is متاحة
كود [IMG] متاحة
كود HTML معطلة

الانتقال السريع