تقييم الموضوع :
  • 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 ك ب / التحميلات : 32)
كود :
For Each Breathe in MyLife
Breathe.Say " سبحان الله والحمد لله ولا إله إلا الله والله أكبر أستغر الله العظيم وأتوب إليه"
Next
الرد
#3
(25-03-19, 01:53 PM)Ahmed_Mansoor كتب : وعليكم السلام ورحمة الله وبركاته

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

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

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

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


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  طلب تعديل كواد زر اختصار الصنف في شاشة المبيعات ahmed250 0 31 29-05-20, 09:30 AM
آخر رد: ahmed250
  تعديل في طريقة حفظ الدرجات مصمم هاوي 30 1,728 07-05-20, 10:44 PM
آخر رد: Ahmed_Mansoor
  تحويل تاريخ الجهاز لفورمات محدد hannileo 1 138 16-04-20, 01:12 AM
آخر رد: AL_BRNS
  كيف يمكن تحويل برنامج الVB6 الى EXE اسلام الكبابى 3 178 22-03-20, 05:03 PM
آخر رد: اسلام الكبابى
  تعديل كواد النسخ الاحتياطيه ahmed20 1 154 14-03-20, 05:05 AM
آخر رد: Ahmed_Mansoor
  تعديل كواد اختصار الصنف في شاشة المبيعات ahmed20 0 129 08-03-20, 02:56 PM
آخر رد: ahmed20
Photo اريد تعديل اداة MSFlexGrid فى هذا المشروع cckills2010 3 323 11-12-19, 03:02 AM
آخر رد: Ahmed_Mansoor
  [سؤال] كيفية تعديل النصوص الموجودة في تطبيق يستخدم res بالفيجوال بيسك 6 بوعيسى 0 264 24-10-19, 10:16 PM
آخر رد: بوعيسى
  سؤال عن تعديل الصورة لم اجد له حل محمد حمد محمد سليمان 3 431 17-09-19, 01:33 PM
آخر رد: awidan76
  تعديل كود البحث mustafa mohamed 1 360 16-09-19, 01:25 PM
آخر رد: عماني939

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


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