الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

مشكلة في تحويل الأرقام الى حروف

مغلق
بدأه nasirraj في 13 نوفمبر 2002 · 4 رد · 631 مشاهدة · في مراجعة المواضيع
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

السلام عليكم

الأخوة الاعضاء

لقد نسخت هذه الوحدة النمطية من المنتدى و لكن المشكلة إن هذه الوحدة النمطية

للتحويل الأرقام الى الحروف بالعربي و لكنني عدلت في الوحدة حيث تتناسب مع الحروف الأنجليزي

و لكنني واجهت هذه المشكلة أدناه:

1444تصبحOnly One Thousand And Four Hundred And Four And Fourty DHs

أريد من الأخوة المساعدة في تعديل الوحدة النمطية أدناه و شكرا

Dim My11 As String

Dim My12 As String

Dim GetTxt As String

Dim Mybillion As String

Dim MyMillion As String

Dim MyThou As String

Dim MyHun As String

Dim MyFraction As String

Dim MyAnd As String

Dim I As Integer

Dim ReMark As String

If TheNo > 999999999999.99 Then Exit Function

If TheNo < 0 Then

TheNo = TheNo * -1

ReMark = "You have "

Else

ReMark = "Only "

End If

If TheNo = 0 Then

NoToTxt = "Zero"

Exit Function

End If

MyAnd = " And "

MyArry1(0) = ""

MyArry1(1) = "Hundred"

MyArry1(2) = "Two Hundred"

MyArry1(3) = "Three Hundred"

MyArry1(4) = "Four Hundred"

MyArry1(5) = "Five Hundred"

MyArry1(6) = "Six Hundred"

MyArry1(7) = "Seven Hundred"

MyArry1(8) = "Eight Hundred"

MyArry1(9) = "Nine Hundred"

MyArry2(0) = ""

MyArry2(1) = " Ten"

MyArry2(2) = "Twenty"

MyArry2(3) = "Thirty"

MyArry2(4) = "Fourty"

MyArry2(5) = "Fifty"

MyArry2(6) = "Sixty"

MyArry2(7) = "Seventy"

MyArry2(8) = "Eighty"

MyArry2(9) = "Ninety"

MyArry3(0) = ""

MyArry3(1) = "One"

MyArry3(2) = "Two"

MyArry3(3) = "Three"

MyArry3(4) = "Four"

MyArry3(5) = "Five"

MyArry3(6) = "Six"

MyArry3(7) = "Seven"

MyArry3(8) = "Eight"

MyArry3(9) = "Nine"

'======================

GetNo = Format(TheNo, "000000000000.00")

I = 0

Do While I < 15

If I < 12 Then

MyNo = Mid$(GetNo, I + 1, 3)

Else

MyNo = "0" + Mid$(GetNo, I + 2, 2)

End If

If (Mid$(MyNo, 1, 3)) > 0 Then

RdNo = Mid$(MyNo, 1, 1)

My100 = MyArry1(RdNo)

RdNo = Mid$(MyNo, 3, 1)

My1 = MyArry3(RdNo)

RdNo = Mid$(MyNo, 2, 1)

My10 = MyArry2(RdNo)

If Mid$(MyNo, 2, 2) = 11 Then My11 = "Eleven"

If Mid$(MyNo, 2, 2) = 12 Then My12 = "Twelve"

If Mid$(MyNo, 2, 2) = 10 Then My10 = "Ten"

If ((Mid$(MyNo, 1, 1)) > 0) And ((Mid$(MyNo, 2, 2)) > 0) Then My100 = My100 + MyAnd

If ((Mid$(MyNo, 3, 1)) > 0) And ((Mid$(MyNo, 2, 1)) > 1) Then My1 = My1 + MyAnd

GetTxt = My100 + My1 + My10

If ((Mid$(MyNo, 3, 1)) = 1) And ((Mid$(MyNo, 2, 1)) = 1) Then

GetTxt = My100 + My11

If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My11

End If

If ((Mid$(MyNo, 3, 1)) = 2) And ((Mid$(MyNo, 2, 1)) = 1) Then

GetTxt = My100 + My12

If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My12

End If

If (I = 0) And (GetTxt <> "") Then

If ((Mid$(MyNo, 1, 3)) > 10) Then

Mybillion = GetTxt + " Billion"

Else

Mybillion = GetTxt + " Billions"

If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = "One Billion"

If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " Two Billions"

End If

End If

If (I = 3) And (GetTxt <> "") Then

If ((Mid$(MyNo, 1, 3)) > 10) Then

MyMillion = GetTxt + " Milion"

Else

MyMillion = GetTxt + " Milions"

If ((Mid$(MyNo, 1, 3)) = 1) Then MyMillion = " One Million"

If ((Mid$(MyNo, 1, 3)) = 2) Then MyMillion = " Two Millions"

End If

End If

If (I = 6) And (GetTxt <> "") Then

If ((Mid$(MyNo, 1, 3)) > 10) Then

MyThou = GetTxt + " Thousand"

Else

MyThou = GetTxt + " thousands"

If ((Mid$(MyNo, 3, 1)) = 1) Then MyThou = " One Thousand"

If ((Mid$(MyNo, 3, 1)) = 2) Then MyThou = " Two Thousands"

End If

End If

If (I = 9) And (GetTxt <> "") Then MyHun = GetTxt

If (I = 12) And (GetTxt <> "") Then MyFraction = GetTxt

End If

I = I + 3

Loop

If (Mybillion <> "") Then

If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd

End If

If (MyMillion <> "") Then

If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd

End If

If (MyThou <> "") Then

If (MyHun <> "") Then MyThou = MyThou + MyAnd

End If

If MyFraction <> "" Then

If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then

NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur

Else

NoToTxt = ReMark + MyFraction + " " + MySubCur

End If

Else

NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur

End If

End Function

#2

أخونا العزيز

يوجد فى الارشيف مثال يحوي 12 دالة سليمة

و المثال نفسه

http://www14.brinkster.com/mtarafa/forms/Punct.zip

و فى الاكسل

http://www14.brinkster.com/mtarafa/xls/Punct_ALl.zip

#3

السلام عليكم

يوجد مثال آخر أيضا :

http://www.arabteam2000.com/vb/showthread....%CA%DD%DE%ED%D8

آمل من الأخ محمد طاهر إضافته على مثال الـ 12 دالة ويفضل إزالة الدالة القديمة واستبدالها بالجديدة مع شكري وتقديري .

تحياتي

#4

أخي العزيز أبو هادي

وجهة نظري أن المثال الجديد أقوي من المجموعة السابقة

فهو مستوي مختلف;)

و ليس تفقيط علي الطاير و لكن تفقيط متعدد الخيارات

لم أنقل مواضيع للأرشيف منذ العودة للمنتدي الحالي

و أفضل نقله كموضوع منفصل و ترك السابق علي حاله

و ساكمل النقل باذن الله

فهل توافقني ؟؟

#5

كما تحب أخي الفاضل

هذا الموضوع مغلق.

مواضيع مشابهة