تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
تفقيط الارقام ( تحويل الأرقام 123 إلى مائة وثلاث وعشرون )
#1
كاتب الموضوع : AhmedEssawy

هذه الدالة تستخدم لتحويل الأرقام المكتوبة إلى رقم مرفق بنوع ، فمثلاً الرقم :
1024.5

يتم تحويله إلى
ألف وأربعة وعشرون جنيه و50 قرش .

الدالة للأخ (بدرميديا) من المنتدى القديم ...


كود :
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
وتعتمد الفكرة باختصار على مجموعة من الشروط لقراءة الارقام وما يعادلها مكتوباً ، ومن ثم دمج الأرقام بطريقة مناسبة لتظهر مفقوطة ومكتوبة بالطريقة الصحيحة .
}}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  Function لتحويل الارقام الى كلمات ولد رائع 4 1,378 10-02-13, 02:57 AM
آخر رد: ولد رائع
  كيفية تحويل المشروع إلى exe من خلال الكود RaggiTech 0 665 17-10-12, 12:52 AM
آخر رد: RaggiTech
  تقريب الأرقام الكسرية للأكبر وللأصغر RaggiTech 0 496 17-10-12, 12:42 AM
آخر رد: RaggiTech
  تفقيط الأرقام باللغة الإنجليزية RaggiTech 0 1,355 17-10-12, 12:41 AM
آخر رد: RaggiTech
  تحويل من الصيغه رقم الي وقت RaggiTech 0 327 17-10-12, 12:34 AM
آخر رد: RaggiTech
  تحويل الرقم العشري الي Bin- Oct- Hex RaggiTech 0 424 17-10-12, 12:33 AM
آخر رد: RaggiTech
  تحويل الحرف الأول من كل كلمة إلى Capital RaggiTech 0 417 17-10-12, 12:33 AM
آخر رد: RaggiTech
  تحويل التنسيق بايت الي Kb- Mb- Gb بالكود RaggiTech 0 423 17-10-12, 12:33 AM
آخر رد: RaggiTech

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


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم