تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[سؤال] تعديل على كود تحويل الرقم الى نص(التفقيط) رجاءً
#1
كود :
Public Function NumToText(ByVal dblValue As Double) As String
Static ones(0 To 9) As String
Static teens(0 To 9) As String
Static tens(0 To 9) As String
Static thousands(0 To 4) As String
Dim i, x, y As Integer, nPosition As Integer
Dim nDigit As Integer, bAllZeros As Integer
Dim strResult As String, strTemp As String, strTemp1 As String
Dim tmpBuff As String


ones(0) = "صفر"
ones(1) = "واحدة"
ones(2) = "اثنتان"
ones(3) = "ثلاث"
ones(4) = "أربع"
ones(5) = "خمس"
ones(6) = "ست"
ones(7) = "سبع"
ones(8) = "ثمان"
ones(9) = "تسع"

teens(0) = "عشر"
teens(1) = "أحدى عشرة"
teens(2) = "أثنتا عشرة"
teens(3) = "ثلاث عشرة"
teens(4) = "أربع عشرة"
teens(5) = "خمس عشرة"
teens(6) = "ست عشرة"
teens(7) = "سبع عشرة"
teens(8) = "ثماني عشرة"
teens(9) = "تسع عشرة"

tens(0) = ""
tens(1) = "عشر "
tens(2) = "عشرون"
tens(3) = "ثلاثون"
tens(4) = "اربعون"
tens(5) = "خمسون"
tens(6) = "ستون"
tens(7) = "سبعون"
tens(8) = "ثمانون"
tens(9) = "تسعون"

thousands(0) = ""
thousands(1) = "الف"
thousands(2) = "مليون"
thousands(3) = "بليون"
thousands(4) = "ترلبون"

'Trap errors
On Error GoTo NumToTextError

'Get fractional part
strResult = Format((dblValue - Int(dblValue)) * 100)
'Convert rest to string and process each digit
strTemp = CStr(Int(dblValue))

'Iterate through string
For i = Len(strTemp) To 1 Step -1
'Get value of this digit
nDigit = Val(Mid$(strTemp, i, 1))
'Get column position
nPosition = (Len(strTemp) - i) + 1
'Action depends on 1's, 10's or 100's column
Select Case (nPosition Mod 3)
Case 1 '1's position
bAllZeros = False
If i = 1 Then
tmpBuff = ones(nDigit) & " "
ElseIf Mid$(strTemp, i - 1, 1) = "1" Then
tmpBuff = teens(nDigit) & " "
i = i - 1 'Skip tens position
ElseIf nDigit > 0 Then
tmpBuff = ones(nDigit) & " "
Else
'If next 10s & 100s columns are also
'zero, then don't show 'thousands'
bAllZeros = True
If i > 1 Then
If Mid$(strTemp, i - 1, 1) <> "0" Then
bAllZeros = False
End If
End If
If i > 2 Then
If Mid$(strTemp, i - 2, 1) <> "0" Then
bAllZeros = False
End If
End If
tmpBuff = ""
End If
If bAllZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & thousands(nPosition / 3) & " "
End If
strResult = tmpBuff & strResult
Case 2 'Tens position
If nDigit > 0 Then
strResult = tens(nDigit) & " " & strResult
End If
Case 0 'Hundreds position
If nDigit > 0 Then
strResult = ones(nDigit) & " مائة " & strResult
End If
End Select
Next i
'Convert first letter to upper case
'If Len(strResult) > 0 Then
'strResult = UCase$(Left$(strResult, 1)) & Mid$(strResult, 2)
'End If

EndNumToText:

'Return result
y = Len(strResult)
strTemp1 = Mid(strResult, 1, y - 1)

NumToText = strTemp1 & "درجة فقط"
Exit Function

NumToTextError:
strResult = "#Error#"
Resume EndNumToText
End Function
الاخوة المشرفون و الاعضاء الكرام

السلام عليكم
ارجو التعديل على هذا الكود لتحويل الرقم الى نص
كان سابقا خاص باللغة الانكليزية وعدلت عليه لكن النص يظهر كما في الصورة المرفقة
مع شكري الجزيل لكم لما تبدوه من مساعدة قل نظيرها


الملفات المرفقة صورة/صور
   
الرد
تم الشكر بواسطة: Microformt
#2
وعليكم السلام ورحمة الله وبركاته

أهلا بك أخي الكريم , هذا مثال آخر على ماتريد .


الملفات المرفقة
.rar   ConvertNumbersToChars.rar (الحجم : 2.57 ك ب / التحميلات : 23)
كود :
For Each Breathe in MyLife
Breathe.Say " سبحان الله والحمد لله ولا إله إلا الله والله أكبر أستغر الله العظيم وأتوب إليه"
Next
الرد
#3
(25-03-19, 01:53 PM)Ahmed_Mansoor كتب : وعليكم السلام ورحمة الله وبركاته

أهلا بك أخي الكريم , هذا مثال آخر على ماتريد .

 اخي العزيز  احمد منصور حفظة الله
يوجد خطاء نامل التعديل علية إذا سمحت  وتكرمت علينا 

  المشكلة 
 1-عندما اكتب   خمسة الف وريال واحد  تظهر الكتابة خمسون الف وريال واحد؟
2 - عند مسح Text يظهر خطاء في الكود ؟

 والله يحفظكم ويرعاكم 
 تحياتي
إذا ضاقت بك الأحوال يوماً     فَثِقْ بالواحِدِ الفَرْدِ العَلِيِّ
الرد
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [مشروع] تعديل كود معرفة اللاسماء الغير موجودة في جدول mustafa mohamed 3 100 16-07-19, 04:23 PM
آخر رد: mustafa mohamed
  تعديل كود محمد حمد محمد سليمان 2 105 16-07-19, 01:11 AM
آخر رد: محمد حمد محمد سليمان
  سؤال: تعديل على كود ايجاد العدد الأصغر haider kh 5 182 05-07-19, 02:22 AM
آخر رد: مصمم هاوي
  تحويل الارقام من الانجليزية للعربية dr.mostashar 7 418 22-02-19, 09:57 PM
آخر رد: AL_BRNS
  [vb6.0] طريقة تعديل REG_BINARY في محرر الريجستري للويندوز الرجل الرمادي 2 271 03-02-19, 04:06 PM
آخر رد: الرجل الرمادي
  [كود] تحويل لغة الكتابة تلقائيا hachemi 3 3,025 06-01-19, 12:58 AM
آخر رد: عماد البشبيشى
  سؤال - كيف يتم تحويل المصفوفه الثنائيه الى احاديه اسامه الجبوري 5 431 01-01-19, 04:44 PM
آخر رد: عبدالله الصافي
  تعديل على انشاء فورم لادخال ارقام الجلوس للطلاب باختيار الصف والفصل محمد تريكه 5 493 30-07-18, 07:39 AM
آخر رد: elgokr
  [vb6.0] مشكلة الرقم عشرة princeofislam 2 352 19-05-18, 11:23 PM
آخر رد: princeofislam
  تحويل من ملف اكسل الى اكسس hannileo 4 541 07-05-18, 09:43 AM
آخر رد: hannileo

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


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