ارجوا المساعدة في اعطائي كود لتحويل الارقام الى حروف
ملاحظة االارقام هى ارقام ماليه مثلاً 45,564.231
خمسة واربعون الف وخمسمائة واربعة وستون دينار ومئتان وواحد وثلاثون درهم لا غير
ارجوا المساعدة في اسرع وقت ممكن
وجزاءكم الله كل الخير
(22-01-17, 01:20 PM)محمد بوقزاحة كتب : ارجوا المساعدة في اعطائي كود لتحويل الارقام الى حروف
ملاحظة االارقام هى ارقام ماليه مثلاً 45,564.231
خمسة واربعون الف وخمسمائة واربعة وستون دينار ومئتان وواحد وثلاثون درهم لا غير
ارجوا المساعدة في اسرع وقت ممكن
وجزاءكم الله كل الخير
تفضل اخي
المصدر (RamyEmad)
تنشئ ميديول وتحطها فيه لكي تستدعيها على مستوى البرنامج
كود :
Function NoToTxt(ByVal TheNo As Double, ByVal MyCur As String, ByVal MySubCur As String) As String
Dim MyArry1(0 To 9) As String
Dim MyArry2(0 To 9) As String
Dim MyArry3(0 To 9) As String
Dim MyNo As String = ""
Dim GetNo As String = ""
Dim RdNo As String = ""
Dim My100 As String = ""
Dim My10 As String = ""
Dim My1 As String = ""
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
End If
If TheNo = 0 Then
NoToTxt = "صفر"
Exit Function
End If
If Mid$(MyNo, 2, 2) = 11 Then My11 = "إحدى عشر"
If Mid$(MyNo, 2, 2) = 12 Then My12 = "إثنى عشر"
If Mid$(MyNo, 2, 2) = 10 Then My10 = "عشرة"
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 + " مليار"
Else
Mybillion = GetTxt + " مليارات"
If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " مليار"
If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " ملياران"
End If
End If
If (i = 3) And (GetTxt <> "") Then
If ((Mid$(MyNo, 1, 3)) > 10) Then
MyMillion = GetTxt + " مليون"
Else
MyMillion = GetTxt + " ملايين"
If ((Mid$(MyNo, 1, 3)) = 1) Then MyMillion = " مليون"
If ((Mid$(MyNo, 1, 3)) = 2) Then MyMillion = " مليونان"
End If
End If
If (i = 6) And (GetTxt <> "") Then
If ((Mid$(MyNo, 1, 3)) > 10) Then
MyThou = GetTxt + " ألف"
Else
MyThou = GetTxt + " آلاف"
If ((Mid$(MyNo, 3, 1)) = 1) Then MyThou = " ألف"
If ((Mid$(MyNo, 3, 1)) = 2) Then MyThou = " ألفان"
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
انا جربت اكواد من قيل ونفس المشكلة اعاني منها هي اخر درهم
هذه صوره توضح لك انا اخر درهم لم يحتسب 555 الصحيح خمسمائة وخمسة وخمسون درهم
في الكود ستة وخمسون درهم
(22-01-17, 03:41 PM)محمد بوقزاحة كتب : انا جربت اكواد من قيل ونفس المشكلة اعاني منها هي اخر درهم
هذه صوره توضح لك انا اخر درهم لم يحتسب 555 الصحيح خمسمائة وخمسة وخمسون درهم
في الكود ستة وخمسون درهم