سؤالي هو كيفية تحويل الرقم الي نص
مثلاً 1500 موجوده في حقل(1) يتم ترجمتها في حقل (2) في نفس الجدول الى "الف وخمسمائة" بحيث يصبح الجدول يشتمل على القيمة الرقمية والقيمة النصية
تحويل الأرقام إلى حروف 22 تتحول إلى اثنان وعشرون
مغلق
لدي عدة طرق .
ساكتب لك واحدة أو اثنتان فانتظر بعض الوقت .
ولك تحياتي
الأخ صالح محمد
نسيت أن أرحب بك في منتدنا المنتدى العربي فأهلا بك وسهلا .
بخصوص تحويل الأرقام الى كتابة لدي سؤال لماذا تضع حقل في النموذج لتحويل الأرقام كتابة فهذا خطأ لا مبرر له والصحيح أن تضع حقل على تقرير لإظهار الرقم كتابة ، وإليك الآن الطريقة الأولى وهي على نموذج وإن شئت وضعت لك طريقتها في التقرير :
في الوحدة النمطية العامة ضع :
Option Compare Database
Public الرقم_رقماً, الرقم_كتابة
Public Ones(0 To 12) As String
Public Twos(2 To 9) As String
Public Threes(1 To 2) As String
Public Fours(1 To 3) As String
Public Sevens(1 To 3) As String
Public Tens(1 To 2) As String
Public Prepositions() As String
Public Decimals(1 To 3) As String
Public Function Main()
Dim lRange As Long
Dim lPosDecimal As Long
Dim sWhole As String, sDecimal As String
On Error Resume Next
LoadArrays
الرقم_رقماً = Forms![نموذج1]![نص84]
lRange = Len(الرقم_رقماً)
If lRange <> 0 Then
lPosDecimal = InStr(1, الرقم_رقماً, ".", vbTextCompare)
If lPosDecimal > 0 Then
sWhole = Mid(الرقم_رقماً, 1, lPosDecimal - 1)
sDecimal = Mid(الرقم_رقماً, lPosDecimal + 1)
sWhole = sLeftRemove(sWhole, "0")
sDecimal = sRightRemove(sDecimal, "0")
If InStr(sDecimal, ".") Then sDecimal = sFindReplace(sDecimal, ".", "")
If InStr(sWhole, ",") Then sWhole = sFindReplace(sWhole, ",", "")
If InStr(sWhole, "،") Then sWhole = sFindReplace(sWhole, "،", "")
If InStr(sDecimal, ",") Then sWhole = sFindReplace(sDecimal, ",", "")
If InStr(sDecimal, "،") Then sWhole = sFindReplace(sDecimal, "،", "")
If Len(sDecimal) > 9 And Len(sWhole) > 9 Then
MsgBox "Sorry:This addin does not support more than 9 digits for " & _
"whole and decimal portion of the number", vbOKOnly, "Number to Text"
Exit Function
End If
If Len(sWhole) > 9 Then
MsgBox "Sorry:This addin does not support more than 9 digits for " & _
"whole portion of the number", vbOKOnly, "Number to Text"
Exit Function
End If
If Len(sDecimal) > 9 Then
MsgBox "Sorry:This addin does not support more than 9 digits for " & _
"decimal portion of the number", vbOKOnly, "Number to Text"
Exit Function
End If
If sDecimal <> "" Then
If CLng(sDecimal) <> 0 Then
If sWhole <> "" Then
If CLng(sWhole) <> 0 Then
الرقم_كتابة = sNum2Text(CLng(sWhole)) & " " & Prepositions(1) & _
sDec2Text(sDecimal)
Else
الرقم_كتابة = sDec2Text(sDecimal)
End If
Else
الرقم_كتابة = sDec2Text(sDecimal)
End If
Else
الرقم_كتابة = sNum2Text(CLng(sWhole))
End If
Else
الرقم_كتابة = sNum2Text(CLng(sWhole))
End If
Else 'Only whole number
If InStr(sWhole, ",") Then sWhole = sFindReplace(sWhole, ",", "")
If InStr(sWhole, "،") Then sWhole = sFindReplace(sWhole, "،", "")
sWhole = الرقم_رقماً
sWhole = sLeftRemove(sWhole, "0")
If Len(sWhole) > 9 Then
MsgBox "Sorry:This addin does not support more than 9 digits for " & _
"whole portion of the number", vbOKOnly, "Number to Text"
Exit Function
End If
الرقم_كتابة = sNum2Text(CLng(sWhole))
End If
End If
' MsgBox الرقم_كتابة
End Function
Public Function sNum2Text(lNum As Long) As String
Dim sNum As String 'The number as string to pass as a vlaue name in the INI file
Dim i As Integer 'Loop counter to loop through all of the digits
Dim iUpperBound As Integer 'Represents # of digits in each group of 3 significant bits
On Error Resume Next
sNum = Trim$(CStr(lNum))
'Get rid of the zeros to the left
If (lNum >= 0) And (lNum <= 12) Then '0 through 12
sNum2Text = Ones(lNum)
ElseIf lNum Mod 10 = 0 And Len(sNum) = 2 Then '20,30,40,...,90
sNum2Text = Twos(CLng(Left(sNum, 1)))
ElseIf lNum > 12 And lNum < 20 Then '13 to 19
sNum2Text = Ones(CLng(Right(sNum, 1))) & " " & Ones(10)
ElseIf lNum Mod 10 > 0 And Len(sNum) = 2 Then '21,22,...29,31,32,33,...,99
sNum2Text = Ones(CLng(Right(sNum, 1))) & " " & Prepositions(1) & _
Twos(CLng(Left(sNum, 1)))
ElseIf (lNum = 100) Or (lNum = 200) Then '100,200
sNum2Text = Threes(CLng(Left(sNum, 1)))
ElseIf (lNum Mod 100) = 0 And Len(sNum) = 3 Then '300,400,500,...,900
sNum2Text = Ones(CLng(Left(sNum, 1))) & " " & Threes(1)
ElseIf lNum Mod 100 > 0 And Len(sNum) = 3 Then '101,102,103,...,199,201,...999
If Left(sNum, 1) <> "1" And Left(sNum, 1) <> "2" Then
sNum2Text = Ones(CLng(Left(sNum, 1))) & " " & Threes(1)
Else
sNum2Text = Threes(CLng(Left(sNum, 1)))
End If
If Right(sNum, 2) = "11" Or Right(sNum, 2) = "12" Then
sNum2Text = sNum2Text & " " & Prepositions(1) & Ones(CLng(Right(sNum, 2)))
ElseIf Mid(sNum, 2, 1) <> "0" And Mid(sNum, 2, 1) <> "1" And Right(sNum, 1) <> 0 Then
sNum2Text = sNum2Text & " " & Prepositions(1) & Ones(CLng(Right(sNum, 1))) & _
" " & Prepositions(1) & Twos(CLng(Mid(sNum, 2, 1)))
ElseIf Mid(sNum, 2, 1) <> "0" And Mid(sNum, 2, 1) <> "1" And Right(sNum, 1) = 0 Then
sNum2Text = sNum2Text & " " & Prepositions(1) & Twos(CLng(Mid(sNum, 2, 1)))
ElseIf Mid(sNum, 2, 1) = "1" Then
sNum2Text = sNum2Text & " " & Prepositions(1) & Ones(CLng(Right(sNum, 1))) & _
" " & Ones(10)
ElseIf Mid(sNum, 2, 1) = "0" Then
sNum2Text = sNum2Text & " " & Prepositions(1) & Ones(CLng(Right(sNum, 1)))
Else 'Right(sNum, 2) = "00"
sNum2Text = sNum2Text
End If
ElseIf Len(sNum) / 3 > 1 Then
Do Until Len(sNum) = 3
If Len(sNum) Mod 3 <> 0 Then
iUpperBound = Len(sNum) Mod 3
Else
iUpperBound = 3
End If
If (Len(sNum) / 3 > 2) And (Len(sNum) / 3 < 4) Then
'In the millions
If Mid(sNum, 1, iUpperBound) = "000" Then
Exit Do
ElseIf (Len(sNum) Mod 3 = 1) And (Left(sNum, 1) = "1" Or Left(sNum, 1) = "2") Then
sNum2Text = sNum2Text & Sevens(CLng(Left(sNum, 1))) & " " & Prepositions(1)
ElseIf (Len(sNum) Mod 3 = 1) And Left(sNum, 1) <> "1" And Left(sNum, 1) <> "2" Then
sNum2Text = sNum2Text & sNum2Text(CLng(Mid(sNum, 1, iUpperBound))) & _
" " & Sevens(3) & " " & Prepositions(1)
ElseIf (Len(sNum) Mod 3 = 2) And Left(sNum, 2) = "10" Then
sNum2Text = sNum2Text & sNum2Text(CLng(Mid(sNum, 1, iUpperBound))) & _
" " & Sevens(3) & " " & Prepositions(1)
Else
sNum2Text = sNum2Text & sNum2Text(CLng(Mid(sNum, 1, iUpperBound))) & _
" " & Sevens(1) & " " & Prepositions(1)
End If
ElseIf (Len(sNum) / 3 >= 1) And (Len(sNum) / 3 < 3) Then
'In the thousands
If Mid(sNum, 1, iUpperBound) = "000" Then
Exit Do
ElseIf (Len(sNum) Mod 3 = 1) And (Left(sNum, 1) = "1" Or Left(sNum, 1) = "2") Then
sNum2Text = sNum2Text & Fours(CLng(Left(sNum, 1))) & " " & Prepositions(1)
ElseIf (Len(sNum) Mod 3 = 1) And Left(sNum, 1) <> "1" And Left(sNum, 1) <> "2" Then
sNum2Text = sNum2Text & sNum2Text(CLng(Mid(sNum, 1, iUpperBound))) & _
" " & Fours(3) & " " & Prepositions(1)
ElseIf (Len(sNum) Mod 3 = 2) And Left(sNum, 2) = "10" Then
sNum2Text = sNum2Text & sNum2Text(CLng(Mid(sNum, 1, iUpperBound))) & _
" " & Fours(3) & " " & Prepositions(1)
Else
sNum2Text = sNum2Text & sNum2Text(CLng(Mid(sNum, 1, iUpperBound))) & _
" " & Fours(1) & " " & Prepositions(1)
End If
End If
sNum = Mid(sNum, iUpperBound + 1)
lNum = CLng(sNum)
'Make sure the least significant 6 digits are not zero
If sNum = String(Len(sNum), "0") Then
sNum2Text = Left(sNum2Text, Len(sNum2Text) - 1)
Exit Function
End If
Loop
'Make sure the least significant 3 digits are not zero
If sNum <> String(Len(sNum), "0") Then
sNum2Text = sNum2Text & sNum2Text(lNum)
Else 'get ride of the AND
sNum2Text = Left(sNum2Text, Len(sNum2Text) - 1)
End If
End If
End Function
Public Function sDec2Text(sNum As String) As String
Dim lLen As Long
On Error Resume Next
Do While Right(sNum, 1) = "0"
sNum = Left(sNum, Len(Trim(sNum)) - 1)
Loop
lLen = Len(Trim(sNum))
If lLen = 0 Then
sDec2Text = ""
Exit Function
ElseIf lLen = 1 Then
Select Case sNum
Case "0"
sDec2Text = ""
Case "1"
sDec2Text = Decimals(1)
Case "2"
sDec2Text = Decimals(2)
Case Else
sDec2Text = sNum2Text(CLng(Trim(sNum))) & " " & Decimals(3)
End Select
ElseIf lLen = 2 Then
sDec2Text = sNum2Text(CLng(Trim(sNum))) & " " & Prepositions(2) & _
sNum2Text("1" & String(lLen, "0"))
ElseIf lLen = 9 Then
sDec2Text = sNum2Text(CLng(Trim(sNum))) & " " & Prepositions(3) & _
Tens(1)
Else
sDec2Text = sNum2Text(CLng(Trim(sNum))) & " " & Prepositions(3) & _
sNum2Text("1" & String(lLen, "0"))
End If
End Function
Public Sub LoadArrays()
'Load the arrays with values
'Ones
Ones(0) = "صفر"
Ones(1) = "واحد"
Ones(2) = "اثنان"
Ones(3) = "ثلاثة"
Ones(4) = "أربعة"
Ones(5) = "خمسة"
Ones(6) = "ستة"
Ones(7) = "سبعة"
Ones(8) = "ثمانية"
Ones(9) = "تسعة"
Ones(10) = "عشرة"
Ones(11) = "أحد عشرة"
Ones(12) = "اثنا عشرة"
'Twos
Twos(2) = "عشرون"
Twos(3) = "ثلاثون"
Twos(4) = "أربعون"
Twos(5) = "خمسون"
Twos(6) = "ستون"
Twos(7) = "سبعون"
Twos(8) = "ثمانون"
Twos(9) = "تسعون"
'Threes
Threes(1) = "مائة"
Threes(2) = "مائتان"
'Fours
Fours(1) = "ألف"
Fours(2) = "ألفان"
Fours(3) = "آلاف"
'Sevens
Sevens(1) = "مليون"
Sevens(2) = "مليونان"
Sevens(3) = "ملايين"
'Tens
Tens(1) = "بليون"
Tens(2) = "بلايين"
'Prepositions
ReDim Prepositions(1 To 3)
Prepositions(1) = "و"
Prepositions(2) = "بال"
Prepositions(3) = "من ال"
'Decimals
Decimals(1) = "عشر"
Decimals(2) = "عشران"
Decimals(3) = "أعشار"
End Sub
Public Function sFindReplace(sString As String, sOld As String, sNew As String) As String
On Error GoTo sFindReplace_Hndlr
Dim i As Integer
sFindReplace = sString
i = 1
'Loop through all the characters of a string
For j = 1 To Len(sString)
If InStr(sOld, Mid(sFindReplace, i, 1)) Then
sFindReplace = Mid(sFindReplace, 1, i - 1) & sNew & Mid(sFindReplace, i + 1)
i = i - 1
End If
i = i + 1
Next j
Exit Function
sFindReplace_Hndlr:
Debug.Print "RTE Desc: " & Err.Description
Debug.Print "RTE Num: " & Err.Number
sFindReplace = sString
Exit Function
End Function
Public Function sLeftRemove(str1 As String, str2 As String) As String
On Error Resume Next
If str1 = "0" And str2 = "0" Then
sLeftRemove = str1
Exit Function
End If
Do While Left(str1, 1) = str2
str1 = Mid(str1, 2)
Loop
If str1 = "" Then str1 = "0"
sLeftRemove = str1
End Function
Public Function sRightRemove(str1 As String, str2 As String) As String
On Error Resume Next
If str1 = "0" And str2 = "0" Then
sRightRemove = str1
Exit Function
End If
Do While Right(str1, 1) = str2
str1 = Mid(str1, 1, Len(str1) - 1)
Loop
If str1 = "" Then str1 = "0"
sRightRemove = str1
End Function
وفي النموذج في حدث عند الخروج من حقل الرقم ضع :
Private Sub حقل_الرقم_Exit(Cancel As Integer)
If Not IsNull(Me!حقل_الرقم) Then
الرقم_رقماً = حقل_الرقم
Call Main
[حقل_الكتابة] = الرقم_كتابة
End If
End Sub
واللي ما فهم يسأل فما كتبته إلا للفائدة .
وللجميع تحياتي
الطريقة الثانية
وهي تحتاج إلى تطوير وتحسين .
في الوحدة النمطية العامة ضع :
Option Compare Database
Public الرقم_رقماً, الرقم_كتابة
Public Sub تحويل_الرقم_كتابة()
Dim تجربة, رقم_أولي, قراءة_أولى
Dim الأرقام_بعد_الفاصلة
Dim رقم_صفري, الآحاد, العشرات, المئات, الألوف, عشرات_الألوف, مئات_الألوف, ملايين
Dim الفئة As String
Const ريال = "ريال"
' الآحاد
' الشرط التالي لغرض عدم إدخال رقم صحيح عند وجود رقم واحد للهللة
'MsgBox الرقم_رقماً
'MsgBox Fix(الرقم_رقماً) * 100
'الأرقام_بعد_الفاصلة = CInt((الرقم_رقماً - Fix(الرقم_رقماً)) * 100)
'MsgBox الأرقام_بعد_الفاصلة
If Right([الرقم_رقماً], 3) < 1 Then
الأرقام_بعد_الفاصلة = Right([الرقم_رقماً], 3)
Else
الأرقام_بعد_الفاصلة = Right([الرقم_رقماً], 2)
End If
If الأرقام_بعد_الفاصلة >= 1 Then
الأرقام_بعد_الفاصلة = 0
End If
'الشرط التالي لغرض عدم الطرح إذا لم يوجد أرقام بعد الفاصلة
If الأرقام_بعد_الفاصلة < 1 Then
الرقم_رقماً = الرقم_رقماً - الأرقام_بعد_الفاصلة
End If
قراءة_أولى = Left([الرقم_رقماً], 1)
رقم_أولي = Choose(قراءة_أولى, "واحد", "إثنان", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية", "تسعة")
' رقم واحد
If Len([الرقم_رقماً]) = 1 Then
' تعديل واحد ريال
[الرقم_كتابة] = رقم_أولي & " " & "ريالات"
If [الرقم_كتابة] = "واحد ريالات" Then [الرقم_كتابة] = "ريال واحد"
' تعديل اثنين ريال
If [الرقم_كتابة] = "إثنان ريالات" Then [الرقم_كتابة] = "ريالان"
End If
' الأرقام من 11 الى 19
' رقمين
' يبدأ بالعشرة لوحدها لوجد لاحقة عشر في الإجراء الثاني
If Len([الرقم_رقماً]) = 2 And Left([الرقم_رقماً], 2) = 10 Then
[الرقم_كتابة] = "عشرة ريالات"
End If
' الأرقام بعد العشرة
If Len([الرقم_رقماً]) = 2 And Left([الرقم_رقماً], 2) <= 19 And Left([الرقم_رقماً], 2) >= 11 Then
[الرقم_كتابة] = Choose(Right([الرقم_رقماً], 1), "أحد", "إثنى", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية", "تسعة") & " " & "عشر" & " " & "ريالاً"
End If
' من هنا تبدأ ألفاظ العقود
' من 21 الى 99
If Len([الرقم_رقماً]) = 2 And Left([الرقم_رقماً], 2) > 19 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "واحد", "اثنان", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية", "تسعة") & " " & مائة
العشرات = Choose(Left([الرقم_رقماً], 1), "عشر ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
[الرقم_كتابة] = رقم_أولي & العشرات & "ريالاً"
رقم_صفري = Right([الرقم_رقماً], 1)
If رقم_صفري = 0 Then
[الرقم_كتابة] = Choose(Left([الرقم_رقماً], 1), "", "عشرون", "ثلاثون", "أربعون", "خمسون", "ستون", "سبعون", "ثمانون", "تسعون") & " " & "ريالاً"
End If
End If
' المئات
' ثلاثة أرقام
If Len([الرقم_رقماً]) = 3 Then
المئات = Choose(Left([الرقم_رقماً], 1), "مائة ", "مائتان ", "ثلاثمائة ", "أربعمائة ", "خمسمائة ", "ستمائة ", "سبعمائة ", "ثمانمائة ", "تسعمائة ")
' بعد المئات 10
If Mid([الرقم_رقماً], 2, 1) = 1 And Right([الرقم_رقماً], 1) = 0 Then
رقم_أولي = "وعشرة "
العشرات = Choose(Mid([الرقم_رقماً], 2, 1), "", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
[الرقم_كتابة] = المئات & رقم_أولي & العشرات & "ريالات"
End If
' بعد المئات من 11 الى 19
If Mid([الرقم_رقماً], 2, 1) = 1 And Right([الرقم_رقماً], 1) <> 0 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "وأحد ", "وإثنا ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
العشرات = Choose(Mid([الرقم_رقماً], 2, 1), "عشر ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
[الرقم_كتابة] = المئات & رقم_أولي & العشرات & "ريالاً"
End If
' بعد المئات من 20 الى 99
If Mid([الرقم_رقماً], 2, 1) > 1 And Mid([الرقم_رقماً], 2, 1) <= 9 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "وأحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
العشرات = Choose(Mid([الرقم_رقماً], 2, 1), "عشر ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
If العشرات <> "عشر " And Right([الرقم_رقماً], 1) = 1 Then
رقم_أولي = "وواحد "
End If
[الرقم_كتابة] = المئات & رقم_أولي & العشرات & "ريالاً"
End If
' المئات ومن 1 الى 9
If Mid([الرقم_رقماً], 2, 1) = 0 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "واحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
المئات = Choose(Left([الرقم_رقماً], 1), "مائة ", "مائتين ", "ثلاثمائة ", "أربعمائة ", "خمسمائة ", "ستمائة ", "سبعمائة ", "ثمانمائة ", "تسعمائة ")
If رقم_أولي = "واحد " Then رقم_أولي = "وواحد ريال"
If رقم_أولي = "وإثنان " Then رقم_أولي = "وريالان"
[الرقم_كتابة] = المئات & رقم_أولي
If IsNull(رقم_أولي) Then
[الرقم_كتابة] = [الرقم_كتابة] & "ريال"
Else
If رقم_أولي <> "وواحد ريال" And رقم_أولي <> "وريالان" Then
[الرقم_كتابة] = [الرقم_كتابة] & "ريالات"
End If
End If
End If
End If
' الألوف
If Len([الرقم_رقماً]) = 4 Then
الألوف = Choose(Left([الرقم_رقماً], 1), "ألف ", "ألفان ", "ثلاثة الآف ", "أربعة الآف ", "خمسة الآف ", "ستة الآف ", "سبعة الآف ", "ثمانية الآف ", "تسعة الآف ")
المئات = Choose(Mid([الرقم_رقماً], 2, 1), "ومائة ", "ومائتين ", "وثلاثمائة ", "وأربعمائة ", "وخمسمائة ", "وستمائة ", "وسبعمائة ", "وثمانمائة ", "وتسعمائة ")
' بعد الألوف 10
If Right([الرقم_رقماً], 1) = 0 And Mid([الرقم_رقماً], 3, 1) = 1 Then
رقم_أولي = "وعشرة "
العشرات = Choose(Mid([الرقم_رقماً], 3, 1), "", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
[الرقم_كتابة] = الألوف & المئات & رقم_أولي & العشرات & "ريالات"
End If
' بعد الألوف من 11 الى 19
If Mid([الرقم_رقماً], 3, 1) = 1 And Right([الرقم_رقماً], 1) <> 0 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "وأحد ", "وإثنا ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
العشرات = Choose(Mid([الرقم_رقماً], 3, 1), "عشر ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
[الرقم_كتابة] = الألوف & المئات & رقم_أولي & العشرات & "ريالاً"
End If
' بعد الألوف من 20 الى 99
If Mid([الرقم_رقماً], 3, 1) > 1 And Mid([الرقم_رقماً], 3, 1) <= 9 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "وأحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
العشرات = Choose(Mid([الرقم_رقماً], 3, 1), "عشر ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
If العشرات <> "عشر " And Right([الرقم_رقماً], 1) = 1 Then
رقم_أولي = "وواحد "
End If
[الرقم_كتابة] = الألوف & المئات & رقم_أولي & العشرات & "ريالاً"
End If
' الألوف ومن 1 الى 9
If Mid([الرقم_رقماً], 3, 1) = 0 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "واحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
الألوف = Choose(Left([الرقم_رقماً], 1), "ألف ", "ألفين ", "ثلاثة الآف ", "أربعة الآف ", "خمسة الآف ", "ستة الآف ", "سبعة الآف ", "ثمانية الآف ", "تسعة الآف ")
If رقم_أولي = "واحد " Then رقم_أولي = "وواحد ريال"
If رقم_أولي = "وإثنان " Then رقم_أولي = "وريالان"
[الرقم_كتابة] = الألوف & المئات & رقم_أولي
If IsNull(رقم_أولي) Then
[الرقم_كتابة] = [الرقم_كتابة] & "ريال"
Else
If رقم_أولي <> "وواحد ريال" And رقم_أولي <> "وريالان" Then
[الرقم_كتابة] = [الرقم_كتابة] & "ريالات"
End If
End If
End If
End If
'عشرات الألوف
If Len([الرقم_رقماً]) = 5 Then
الألوف = "ألف "
المئات = Choose(Mid([الرقم_رقماً], 3, 1), "ومائة ", "ومائتين ", "وثلاثمائة ", "وأربعمائة ", "وخمسمائة ", "وستمائة ", "وسبعمائة ", "وثمانمائة ", "وتسعمائة ")
If Mid([الرقم_رقماً], 1, 1) = 1 And Mid([الرقم_رقماً], 2, 1) = 0 Then
عشرات_الألوف = "عشرة آلاف "
الألوف = ""
End If
If Mid([الرقم_رقماً], 1, 1) = 1 And Mid([الرقم_رقماً], 2, 1) > 0 Then
عشرات_الألوف = Choose(Mid([الرقم_رقماً], 2, 1), "أحد عشر ", "إثنا عشر ", "ثلاثة عشر ", "أربعة عشر ", "خمسة عشر ", "ستة عشر ", "سبعة عشر ", "ثمانية عشر ", "تسعة عشر ")
End If
If Mid([الرقم_رقماً], 1, 1) > 1 And Mid([الرقم_رقماً], 2, 1) >= 0 Then
عشرات_الألوف = Choose(Mid([الرقم_رقماً], 2, 1), "واحد ", "إثنان ", "ثلاثة ", "أربعة ", "خمسة ", "ستة ", "سبعة ", "ثمانية ", "تسعة ")
عشرات_الألوف = عشرات_الألوف & Choose(Mid([الرقم_رقماً], 1, 1), "", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
End If
' بعد عشرات الألوف 10
If Right([الرقم_رقماً], 1) = 0 And Mid([الرقم_رقماً], 4, 1) = 1 Then
رقم_أولي = "وعشرة "
[الرقم_كتابة] = عشرات_الألوف & الألوف & المئات & رقم_أولي & العشرات & "ريالات"
End If
' بعد الألوف من 11 الى 19
If Mid([الرقم_رقماً], 4, 1) = 1 And Right([الرقم_رقماً], 1) <> 0 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "وأحد ", "وإثنا ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
العشرات = Choose(Mid([الرقم_رقماً], 4, 1), "عشر ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
[الرقم_كتابة] = عشرات_الألوف & الألوف & المئات & رقم_أولي & العشرات & "ريالاً"
End If
' بعد عشرات الألوف من 20 الى 99
If Mid([الرقم_رقماً], 4, 1) > 1 And Mid([الرقم_رقماً], 4, 1) <= 9 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "وأحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
العشرات = Choose(Mid([الرقم_رقماً], 4, 1), "عشر ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
If العشرات <> "عشر " And Right([الرقم_رقماً], 1) = 1 Then
رقم_أولي = "وواحد "
End If
[الرقم_كتابة] = عشرات_الألوف & الألوف & المئات & رقم_أولي & العشرات & "ريالاً"
End If
'عشرات الألوف ومن 1 الى 9
If Mid([الرقم_رقماً], 4, 1) = 0 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "واحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
If رقم_أولي = "واحد " Then رقم_أولي = "وواحد ريال"
If رقم_أولي = "وإثنان " Then رقم_أولي = "وريالان"
[الرقم_كتابة] = عشرات_الألوف & الألوف & المئات & رقم_أولي
If IsNull(رقم_أولي) Then
[الرقم_كتابة] = [الرقم_كتابة] & "ريال"
Else
If رقم_أولي <> "وواحد ريال" And رقم_أولي <> "وريالان" Then
[الرقم_كتابة] = [الرقم_كتابة] & "ريالات"
End If
End If
End If
End If
'''''''''''''''''''''''''''''''''''
' مئات الألوف
'''''''''''''''''''''''''''''''''''
If Len([الرقم_رقماً]) = 6 Then
If Mid([الرقم_رقماً], 2, 1) = 0 And Mid([الرقم_رقماً], 3, 1) <> 0 Then
الفئة = "الآف "
Else
الفئة = "ألف "
End If
المئات = Choose(Mid([الرقم_رقماً], 4, 1), "ومائة ", "ومائتين ", "وثلاثمائة ", "وأربعمائة ", "وخمسمائة ", "وستمائة ", "وسبعمائة ", "وثمانمائة ", "وتسعمائة ")
If Mid([الرقم_رقماً], 2, 1) <> 1 And Mid([الرقم_رقماً], 3, 1) > 0 Then
الألوف = Choose(Mid([الرقم_رقماً], 3, 1), "وواحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
End If
عشرات_الألوف = Choose(Mid([الرقم_رقماً], 2, 1), "", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
مئات_الألوف = Choose(Mid([الرقم_رقماً], 1, 1), "مائة ", "مائتين ", "ثلاثمائة ", "أربعمائة ", "خمسمائة ", "ستمائة ", "سبعمائة ", "ثمانمائة ", "تسعمائة ")
If Mid([الرقم_رقماً], 2, 1) = 1 And Mid([الرقم_رقماً], 3, 1) = 0 Then
عشرات_الألوف = "وعشرة آلاف "
End If
If عشرات_الألوف = "وعشرة آلاف " Then
الفئة = ""
End If
If Mid([الرقم_رقماً], 2, 1) = 1 And Mid([الرقم_رقماً], 3, 1) > 0 Then
عشرات_الألوف = Choose(Mid([الرقم_رقماً], 3, 1), "وأحد عشر ", "وإثنا عشر ", "وثلاثة عشر ", "وأربعة عشر ", "وخمسة عشر ", "وستة عشر ", "وسبعة عشر ", "وثمانية عشر ", "وتسعة عشر ")
End If
' بعد مئات الألوف 10
If Right([الرقم_رقماً], 1) = 0 And Mid([الرقم_رقماً], 5, 1) = 1 Then
رقم_أولي = "وعشرة "
[الرقم_كتابة] = مئات_الألوف & الألوف & عشرات_الألوف & الفئة & المئات & رقم_أولي & العشرات & "ريالات"
End If
' بعد مئات الألوف من 11 الى 19
If Mid([الرقم_رقماً], 5, 1) = 1 And Right([الرقم_رقماً], 1) <> 0 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "وأحد ", "وإثنا ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
العشرات = Choose(Mid([الرقم_رقماً], 5, 1), "عشر ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
[الرقم_كتابة] = مئات_الألوف & الألوف & عشرات_الألوف & الفئة & المئات & رقم_أولي & العشرات & "ريالاً"
End If
' بعد عشرات الألوف من 20 الى 99
If Mid([الرقم_رقماً], 5, 1) > 1 And Mid([الرقم_رقماً], 5, 1) <= 9 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "وأحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
العشرات = Choose(Mid([الرقم_رقماً], 5, 1), "عشر ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
If العشرات <> "عشر " And Right([الرقم_رقماً], 1) = 1 Then
رقم_أولي = "وواحد "
End If
[الرقم_كتابة] = مئات_الألوف & الألوف & عشرات_الألوف & الفئة & المئات & رقم_أولي & العشرات & "ريالاً"
End If
'مئات الألوف ومن 1 الى 9
If Mid([الرقم_رقماً], 5, 1) = 0 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "واحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
If رقم_أولي = "واحد " Then رقم_أولي = "وواحد ريال"
If رقم_أولي = "وإثنان " Then رقم_أولي = "وريالان"
[الرقم_كتابة] = مئات_الألوف & الألوف & عشرات_الألوف & الفئة & المئات & رقم_أولي
If IsNull(رقم_أولي) Then
[الرقم_كتابة] = [الرقم_كتابة] & "ريال"
Else
If رقم_أولي <> "وواحد ريال" And رقم_أولي <> "وريالان" Then
[الرقم_كتابة] = [الرقم_كتابة] & "ريالات"
End If
End If
End If
End If
'''''''''''''''''''''''''''''''''''
' الملايين
'''''''''''''''''''''''''''''''''''
If Len([الرقم_رقماً]) = 7 Then
الفئة = "ألف "
If Mid([الرقم_رقماً], 3, 1) = 0 Then
الألوف = Choose(Mid([الرقم_رقماً], 4, 1), "وواحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
End If
المئات = Choose(Mid([الرقم_رقماً], 5, 1), "ومائة ", "ومائتين ", "وثلاثمائة ", "وأربعمائة ", "وخمسمائة ", "وستمائة ", "وسبعمائة ", "وثمانمائة ", "وتسعمائة ")
مئات_الألوف = Choose(Mid([الرقم_رقماً], 2, 1), "ومائة ", "ومائتين ", "وثلاثمائة ", "وأربعمائة ", "وخمسمائة ", "وستمائة ", "وسبعمائة ", "وثمانمائة ", "وتسعمائة ")
الملايين = Choose(Mid([الرقم_رقماً], 1, 1), "مليون ", "مليونان ", "ثلاثة ملايين ", "أربعة ملايين ", "خمسمة ملايين ", "ستة ملايين ", "سبعة ملايين ", "ثمانية ملايين ", "تسعة ملايين ")
If Mid([الرقم_رقماً], 3, 1) = 1 And Mid([الرقم_رقماً], 4, 1) = 0 Then
عشرات_الألوف = "وعشرة آلاف "
الفئة = ""
End If
If Mid([الرقم_رقماً], 4, 1) >= 1 And Mid([الرقم_رقماً], 4, 1) <= 9 And Mid([الرقم_رقماً], 3, 1) = 0 Then
الفئة = "الآف "
End If
If Mid([الرقم_رقماً], 3, 1) = 1 And Mid([الرقم_رقماً], 4, 1) > 0 Then
الألوف = Choose(Mid([الرقم_رقماً], 4, 1), "وأحد عشر ", "وإثنا عشر ", "وثلاثة عشر ", "وأربعة عشر ", "وخمسة عشر ", "وستة عشر ", "وسبعة عشر ", "وثمانية عشر ", "وتسعة عشر ")
End If
If Mid([الرقم_رقماً], 3, 1) > 1 And Mid([الرقم_رقماً], 4, 1) >= 0 Then
عشرات_الألوف = Choose(Mid([الرقم_رقماً], 4, 1), "وواحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
If Mid([الرقم_رقماً], 3, 1) = 0 And Mid([الرقم_رقماً], 4, 1) <> 0 _
And عشرات_الألوف <> "وواحد " And Mid([الرقم_رقماً], 3, 1) = 0 _
And Mid([الرقم_رقماً], 4, 1) <> 0 And عشرات_الألوف <> "وإثنان " Then
الألوف = "الآف "
End If
'if الألوف=
عشرات_الألوف = عشرات_الألوف & Choose(Mid([الرقم_رقماً], 3, 1), "", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
End If
' بعد مئات الألوف 10
If Right([الرقم_رقماً], 1) = 0 And Mid([الرقم_رقماً], 6, 1) = 1 Then
رقم_أولي = "وعشرة "
[الرقم_كتابة] = الملايين & مئات_الألوف & عشرات_الألوف & الألوف & الفئة & المئات & رقم_أولي & العشرات & "ريالات"
End If
' بعد مئات الألوف من 11 الى 19
If Mid([الرقم_رقماً], 6, 1) = 1 And Right([الرقم_رقماً], 1) <> 0 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "وأحد ", "وإثنا ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
العشرات = Choose(Mid([الرقم_رقماً], 6, 1), "عشر ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
If Mid([الرقم_رقماً], 2, 1) = 0 And Mid([الرقم_رقماً], 3, 1) = 0 And Mid([الرقم_رقماً], 4, 1) = 1 Then
الألوف = "و"
End If
[الرقم_كتابة] = الملايين & مئات_الألوف & عشرات_الألوف & الألوف & الفئة & المئات & رقم_أولي & العشرات & "ريالاً"
End If
' بعد عشرات الألوف من 20 الى 99
If Mid([الرقم_رقماً], 6, 1) > 1 And Mid([الرقم_رقماً], 6, 1) <= 9 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "وأحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
العشرات = Choose(Mid([الرقم_رقماً], 6, 1), "عشر ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
If العشرات <> "عشر " And Right([الرقم_رقماً], 1) = 1 Then
رقم_أولي = "وواحد "
End If
If Mid([الرقم_رقماً], 3, 1) = 1 And Mid([الرقم_رقماً], 4, 1) = 0 Then
عشرات_الألوف = "وعشرة الآف "
الفئة = ""
End If
[الرقم_كتابة] = الملايين & مئات_الألوف & عشرات_الألوف & الألوف & الفئة & المئات & رقم_أولي & العشرات & "ريالاً"
'[الرقم_كتابة] = الملايين & مئات_الألوف & عشرات_الألوف & الألوف & الفئة & المئات & رقم_أولي & العشرات & "ريالاً"
End If
'مئات الألوف ومن 1 الى 9
If Mid([الرقم_رقماً], 6, 1) = 0 Then
رقم_أولي = Choose(Right([الرقم_رقماً], 1), "واحد ", "وإثنان ", "وثلاثة ", "وأربعة ", "وخمسة ", "وستة ", "وسبعة ", "وثمانية ", "وتسعة ")
If رقم_أولي = "واحد " Then رقم_أولي = "وواحد ريال"
If رقم_أولي = "وإثنان " Then رقم_أولي = "وريالان"
If Mid([الرقم_رقماً], 2, 1) = 0 And Mid([الرقم_رقماً], 3, 1) = 0 And Mid([الرقم_رقماً], 4, 1) = 0 Then
الفئة = ""
End If
[الرقم_كتابة] = الملايين & مئات_الألوف & عشرات_الألوف & الألوف & الفئة & المئات & رقم_أولي
If IsNull(رقم_أولي) Then
[الرقم_كتابة] = [الرقم_كتابة] & "ريال واحد"
Else
If رقم_أولي <> "وواحد ريال" And رقم_أولي <> "وريالان" Then
[الرقم_كتابة] = [الرقم_كتابة] & "ريالات"
End If
End If
End If
End If
'''''''''''
' كتابة الهللات
If الأرقام_بعد_الفاصلة <> 0 Then
Dim هللة, رقم_أولي_هللة, العشرات_هللات
الفئة = "هللة "
' الامر التالي لغرض إزالة الفاصلة من الرقم
الأرقام_بعد_الفاصلة = الأرقام_بعد_الفاصلة * 100
If Right([الأرقام_بعد_الفاصلة], 1) <> 0 Then
رقم_أولي_هللة = Choose(Right([الأرقام_بعد_الفاصلة], 1), "وواحد ", "وإثنتان ", "وثلاث ", "وأربع ", "وخمس ", "وست ", "وسبع ", "وثمان ", "وتسع ")
End If
If Len(الأرقام_بعد_الفاصلة) = 2 And Right(الأرقام_بعد_الفاصلة, 1) <> 0 Then
العشرات_هللات = Choose(Left([الأرقام_بعد_الفاصلة], 1), "عشرة ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
End If
If Len(الأرقام_بعد_الفاصلة) = 2 And Right(الأرقام_بعد_الفاصلة, 1) = 0 Then
العشرات_هللات = Choose(Left([الأرقام_بعد_الفاصلة], 1), "وعشر ", "وعشرون ", "وثلاثون ", "وأربعون ", "وخمسون ", "وستون ", "وسبعون ", "وثمانون ", "وتسعون ")
'رقم_أولي_هللة = ""
End If
If العشرات_هللات = "وعشر " And رقم_أولي_هللة = "" Then
الفئة = "هللات "
End If
If رقم_أولي_هللة = "وواحد " And العشرات_هللات = "عشرة " Then
رقم_أولي_هللة = "وإحدى "
End If
If العشرات_هللات = "" Then
رقم_أولي_هللة = Choose(Right([الأرقام_بعد_الفاصلة], 1), "وهللة واحدة ", "وهللتان ", "وثلاث ", "وأربع ", "وخمس ", "وست ", "وسبع ", "وثماني ", "وتسع ")
الفئة = "هللات "
If رقم_أولي_هللة = "وهللة واحدة " Or رقم_أولي_هللة = "وهللتان " Then
الفئة = ""
End If
End If
هللة = رقم_أولي_هللة & العشرات_هللات
If Not IsNull(هللة) Then
الرقم_كتابة = الرقم_كتابة & " " & هللة & الفئة & "فقط لاغير ."
Else
الرقم_كتابة = الرقم_كتابة & " " & هللة & " " & "فقط لاغير ."
End If
Else
الرقم_كتابة = الرقم_كتابة & " " & "فقط لاغير ."
End If
End Sub
وفي حدث عند الخروج من حقل الرقم ضع :
Private Sub حقل_الرقم_Exit(Cancel As Integer)
If Not IsNull(Me!حقل_الرقم) Then
الرقم_رقماً = حقل_الرقم
تحويل_الرقم_كتابة
[حقل_الكتابة] = الرقم_كتابة
End If
End Sub
ولك تحياتي
طريقة ثالثة :
تتكون هذه الطريقة من مربع نص باسم Text1 لكتابة الرقم و مربع عنوان باسم Label1 لإظهار النص و مجموعة خيار فيها زري خيار باسم Option1_Click وذلك لاختيار بين التذكير والتأنيث (1 مذكر و2 مؤنث) .
في الوحدة النمطية الخاصة بالنموذج ضع الأسطر التالية :
Dim Sx As Integer
Dim Num As String
Sub Form_Load()
Sx = 0
End Sub
Sub Text1_Change()
Num = Text1.Text
Label1.Caption = WriteNo(Num, Sx)
End Sub
Sub Option1_Click(Index As Integer)
Sx = Index
Label1.Caption = WriteNo(Num, Sx)
End Sub
وفي الوحدة النمطية العامة ضع الأسطر التالية :
Function GetNo(ns As String, sex As Integer, Power As Integer, frst() As String, frst1() As String, scnd() As String, thrd() As String) As String
Dim Lngth As Integer, InvSex As Integer
ReDim Indx(3) As Integer
ReDim TmpArray(2) As String
Dim tms As String
If sex = 0 Then
InvSex = 1
Else
InvSex = 0
End If
'الحل من أجل ثلاثة أرقام
Lngth = Len(ns)
'الآحاد
Indx(1) = Val(Mid$(ns, Lngth, 1))
TmpArray(0) = frst(Indx(1), sex)
Lngth = Lngth - 1
If Lngth > 0 Then
'العشرات
Indx(2) = Val(Mid$(ns, Lngth, 1))
If TmpArray(0) <> "" Then
TmpArray(1) = scnd(Indx(2), InvSex)
Else
TmpArray(1) = scnd(Indx(2), sex)
End If
If (Indx(2) > 1) And (TmpArray(0) <> "") Then 'العشرات من 1 إلى تسعة
TmpArray(0) = TmpArray(0) + " و"
ElseIf (Indx(1) = 1) And (Indx(2) = 1) Then 'أحد عشر
TmpArray(0) = frst1(1, sex)
ElseIf (Indx(1) = 2) And (Indx(2) = 1) Then ' اثنا عشر
TmpArray(0) = frst1(2, sex)
End If
Lngth = Lngth - 1
If Lngth > 0 Then
'المئات
Indx(3) = Val(Mid$(ns, Lngth, 1))
TmpArray(2) = thrd(Indx(3))
If (Indx(3) > 0) And ((TmpArray(0) <> "") Or (TmpArray(1) <> "")) Then TmpArray(2) = TmpArray(2) + " و"
Else
GoTo last
End If
Else
GoTo last
End If
'إضافة كلمة المرتبة(مئة,ألف,...)حسب مرتبة الأرقام
last:
Select Case Power
Case Is = -1
tms = TmpArray(2) & TmpArray(0) & TmpArray(1)
If (TmpArray(0) <> "") And (TmpArray(1) = "") And (TmpArray(2) = "") Then
GetNo = tms & " بالعشرة"
ElseIf (TmpArray(0) <> "") And (TmpArray(1) <> "") And (TmpArray(2) = "") Then
GetNo = tms & " بالمئة"
ElseIf (TmpArray(0) <> "") And (TmpArray(1) <> "") And (TmpArray(2) <> "") Then
GetNo = tms & " بالألف"
End If
Case Is = 0
GetNo = TmpArray(2) & TmpArray(0) & TmpArray(1)
Case Is = 1
If (Indx(1) = 1) And (Indx(2) = 0) And (Indx(3) = 0) Then
GetNo = " ألف "
ElseIf (Indx(1) = 2) And (Indx(2) = 0) And (Indx(3) = 0) Then
GetNo = " ألفان "
ElseIf (Indx(1) > 2) And (Indx(2) = 0) And (Indx(3) = 0) Then
GetNo = TmpArray(0) & " آلاف "
ElseIf (Indx(1) = 0) And (Indx(2) = 1) And (Indx(3) = 0) Then
GetNo = TmpArray(2) & TmpArray(0) & TmpArray(1) & " آلاف "
ElseIf (Indx(1) = 0) And (Indx(2) = 0) And (Indx(3) = 0) Then
GetNo = TmpArray(2) & TmpArray(0) & TmpArray(1)
Else
GetNo = TmpArray(2) & TmpArray(0) & TmpArray(1) & " ألف "
End If
Case Is = 2
If (Indx(1) = 1) And (Indx(2) = 0) And (Indx(3) = 0) Then
GetNo = " مليون "
ElseIf (Indx(1) = 2) And (Indx(2) = 0) And (Indx(3) = 0) Then
GetNo = " مليونان "
ElseIf (Indx(1) > 2) And (Indx(2) = 0) And (Indx(3) = 0) Then
GetNo = TmpArray(0) & " ملايين "
ElseIf (Indx(1) = 0) And (Indx(2) = 1) And (Indx(3) = 0) Then
GetNo = TmpArray(2) & TmpArray(0) & TmpArray(1) & " ملايين "
ElseIf (Indx(1) = 0) And (Indx(2) = 0) And (Indx(3) = 0) Then
GetNo = TmpArray(2) & TmpArray(0) & TmpArray(1)
Else
GetNo = TmpArray(2) & TmpArray(0) & TmpArray(1) & " مليون "
End If
Case Is = 3
If (Indx(1) = 1) And (Indx(2) = 0) And (Indx(3) = 0) Then
GetNo = " مليار "
ElseIf (Indx(1) = 2) And (Indx(2) = 0) And (Indx(3) = 0) Then
GetNo = " ملياران "
ElseIf (Indx(1) > 2) And (Indx(2) = 0) And (Indx(3) = 0) Then
GetNo = TmpArray(0) & " مليارات "
ElseIf (Indx(1) = 0) And (Indx(2) = 1) And (Indx(3) = 0) Then
GetNo = TmpArray(2) & TmpArray(0) & TmpArray(1) & " مليارات "
Else
GetNo = TmpArray(2) & TmpArray(0) & TmpArray(1) & " مليار "
End If
End Select
End Function
Function WriteNo(no As String, sex As Integer) As String
Static FirstArray(9, 1) As String
Static FirstArray1(2, 1) As String
Static SecondArray(9, 1) As String
Static ThirdArray(9) As String
ReDim Parts(4) As String
ReDim PartStr(-1 To 3) As String
Dim Length As Integer, i As Integer, TempLength As Integer
Dim NoString As String, pos As Integer
Dim AfterPoint As String
Dim txt As String
'sex=0 مذكر
'sex= 1 مؤنث
FirstArray(1, 0) = "واحد ": FirstArray(2, 0) = "اثنان ": FirstArray(3, 0) = "ثلاثة "
FirstArray(4, 0) = "أربعة ": FirstArray(5, 0) = "خمسة ": FirstArray(6, 0) = "ستة "
FirstArray(7, 0) = "سبعة ": FirstArray(8, 0) = "ثمانية ": FirstArray(9, 0) = "تسعة "
FirstArray(1, 1) = "واحدة ": FirstArray(2, 1) = "اثنتان ": FirstArray(3, 1) = "ثلاث "
FirstArray(4, 1) = "أربع ": FirstArray(5, 1) = "خمس ": FirstArray(6, 1) = "ست "
FirstArray(7, 1) = "سبع ": FirstArray(8, 1) = "ثمان ": FirstArray(9, 1) = "تسع "
FirstArray1(1, 0) = "أحد ": FirstArray1(2, 0) = "اثنا "
FirstArray1(1, 1) = "إحدى ": FirstArray1(2, 1) = "اثنتا "
SecondArray(1, 0) = "عشرة ": SecondArray(2, 0) = "عشرون ": SecondArray(3, 0) = "ثلاثون "
SecondArray(4, 0) = "أربعون ": SecondArray(5, 0) = "خمسون ": SecondArray(6, 0) = "ستون "
SecondArray(7, 0) = "سبعون ": SecondArray(8, 0) = "ثمانون ": SecondArray(9, 0) = "تسعون "
SecondArray(1, 1) = "عشر ": SecondArray(2, 1) = "عشرون ": SecondArray(3, 1) = "ثلاثون "
SecondArray(4, 1) = "أربعون ": SecondArray(5, 1) = "خمسون ": SecondArray(6, 1) = "ستون "
SecondArray(7, 1) = "سبعون ": SecondArray(8, 1) = "ثمانون ": SecondArray(9, 1) = "تسعون "
ThirdArray(1) = "مئة ": ThirdArray(2) = "مئتان ": ThirdArray(3) = "ثلاثمئة "
ThirdArray(4) = "أربعمئة ": ThirdArray(5) = "خمسمئة ": ThirdArray(6) = "ستمئة "
ThirdArray(7) = "سبعمئة ": ThirdArray(8) = "ثمانمئة ": ThirdArray(9) = "تسعمئة "
txt = "": i = -1
If Val(no) = 0 Then 'هل العدد المدخل صفر
WriteNo = "صفر"
Exit Function
End If
'احذف الفراغات اليمينية واليسارية الزائدة في حال وجودها
NoString = Trim(no)
' احصل على طول سلسلة العدد
Length = Len(NoString)
'احفظ مكان وجود الفاصلة العشرية
pos = InStr(NoString, ".")
'اقسم سلسلة العددإلى ماقبل الفاصلة ومابعد الفاصلة
If pos > 0 Then
AfterPoint = Right$(NoString, Length - pos)
NoString = Left$(NoString, pos - 1)
Length = Len(NoString)
Else
pos = InStr(NoString, ",")
If pos > 0 Then
AfterPoint = Right$(NoString, Length - pos)
NoString = Left$(NoString, pos - 1)
Length = Len(NoString)
End If
End If
'جزء العدد إلى سلاسل حرفية مؤلفة من ثلاث خانات عشرية أو أقل
TempLength = Length
Parts(0) = NoString
Do While TempLength >= 3
TempLength = TempLength - 3
i = i + 1
Parts(i) = Right$(NoString, 3)
NoString$ = Left$(NoString, TempLength)
Loop
Parts(i + 1) = NoString
'استدع التابع الفرعي واحفظ النتائج في المصفوفة
For i = 0 To 3
If Len(Parts(i)) > 0 Then
PartStr(i) = GetNo(Parts(i), sex, i, FirstArray(), FirstArray1(), SecondArray(), ThirdArray())
Else
Exit For
End If
Next
'ااجمع الكلمات الجزئية الناتجة في عارة واحدة
For i = 3 To 0 Step -1
If Len(PartStr(i)) > 0 Then
If Len(PartStr(i - 1)) > 0 Then
txt = txt & " " & PartStr(i) & "و"
Else
txt = txt & " " & PartStr(i) & " "
End If
End If
Next
If Val(AfterPoint) > 0 Then
txt = txt & "و" & GetNo(AfterPoint, sex, -1, FirstArray(), FirstArray1(), SecondArray(), ThirdArray())
End If
WriteNo = txt
End Function
ولك تحياتي
طريقة رابعة للأرقام الإنجليزية مع قراءة الفواصل العشرية
Function ConvertCurrencyToEnglish (ByVal MyNumber)
Dim Temp
Dim Dollars, Cents
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "
' Convert MyNumber to a string, trimming extra spaces.
MyNumber = Trim(Str(MyNumber))
' Find decimal place.
DecimalPlace = InStr(MyNumber, ".")
' If we find decimal place...
If DecimalPlace > 0 Then
' Convert cents
Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
Cents = ConvertTens(Temp)
' Strip off cents from remainder to convert.
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
' Convert last 3 digits of MyNumber to English dollars.
Temp = ConvertHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
' Remove last 3 converted digits from MyNumber.
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
' Clean up dollars.
Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select
' Clean up cents.
Select Case Cents
Case ""
Cents = " And No Cents"
Case "One"
Cents = " And One Cent"
Case Else
Cents = " And " & Cents & " Cents"
End Select
ConvertCurrencyToEnglish = Dollars & Cents
End Function
Private Function ConvertHundreds (ByVal MyNumber)
Dim Result As String
' Exit if there is nothing to convert.
If Val(MyNumber) = 0 Then Exit Function
' Append leading zeros to number.
MyNumber = Right("000" & MyNumber, 3)
' Do we have a hundreds place digit to convert?
If Left(MyNumber, 1) <> "0" Then
Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
End If
' Do we have a tens place digit to convert?
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & ConvertTens(Mid(MyNumber, 2))
Else
' If not, then convert the ones place digit.
Result = Result & ConvertDigit(Mid(MyNumber, 3))
End If
ConvertHundreds = Trim(Result)
End Function
Private Function ConvertTens (ByVal MyTens)
Dim Result As String
' Is value between 10 and 19?
If Val(Left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else
' .. otherwise it's between 20 and 99.
Select Case Val(Left(MyTens, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
' Convert ones place digit.
Result = Result & ConvertDigit(Right(MyTens, 1))
End If
ConvertTens = Result
End Function
Private Function ConvertDigit (ByVal MyDigit)
Select Case Val(MyDigit)
Case 1: ConvertDigit = "One"
Case 2: ConvertDigit = "Two"
Case 3: ConvertDigit = "Three"
Case 4: ConvertDigit = "Four"
Case 5: ConvertDigit = "Five"
Case 6: ConvertDigit = "Six"
Case 7: ConvertDigit = "Seven"
Case 8: ConvertDigit = "Eight"
Case 9: ConvertDigit = "Nine"
Case Else: ConvertDigit = ""
End Select
End Function
ولتجربتها اكتب :
? ConvertCurrencyToEnglish(1234.56)
ولك تحياتي
الأخ ابو حمود انا عاجز عن الشكر جزاك الله خير
وانا قيد تطبيق ماعرضته وسااخبرك بالنتيجة
اشكر ابوحمود وهذه طريقة أخرى
Function write_Number(numberp) ' برنامج التفقيط
On Error Resume Next
Dim ttpa, xp, a, number_s, fl As String
number_s = Str(numberp)
If Left(Right(number_s, 2), 1) = "." Then number_s = number_s & "0"
If Left(Right(number_s, 3), 1) <> "." Then number_s = number_s & ".00"
number_s = Trim(number_s)
' MsgBox " number_s = " & number_s
zp = Len(number_s)
z = 1
Do While zp > 0
c1 = ""
c2 = ""
c3 = ""
If zp = 12 Or zp = 9 Or zp = 6 Then
a = Mid(number_s, z, 1)
zp = zp - 1
Select Case a
Case "0"
c3 = ""
Case "1"
c3 = "ومائة "
Case "2"
c3 = "ومائتان "
Case "3"
c3 = "وثلاثمائة "
Case "4"
c3 = "واربعمائة "
Case "5"
c3 = "وخمسمائة "
Case "6"
c3 = "وستمائة "
Case "7"
c3 = "وسبعمائة "
Case "8"
c3 = "وثمانمائة "
Case "9"
c3 = "وتسعمائة "
End Select
z = z + 1
End If
If zp = 3 Then
z = z + 1
zp = zp - 1
End If
a = Mid(number_s, z, 1)
If zp = 2 Or zp = 5 Or zp = 8 Or zp = 11 Then
Select Case a
Case "0"
c2 = ""
Case "1"
c2 = "عشر "
Case "2"
c2 = "وعشرون "
Case "3"
c2 = "وثلاثون "
Case "4"
c2 = "واربعون "
Case "5"
c2 = "وخمسون "
Case "6"
c2 = "وستون "
Case "7"
c2 = "وسبعون "
Case "8"
c2 = "وثمانون "
Case "9"
c2 = "وتسعون "
End Select
zp = zp - 1
z = z + 1
End If
a = Mid(number_s, z, 1)
If zp = 1 Then ' الهللات
Select Case a
Case "0"
c1 = ""
Case "1"
If c2 = "عشر " Then
c1 = "واحدى "
Else
c1 = "وواحد "
End If
Case "2"
If c2 = "عشر " Then
c1 = "واثنتا "
Else
c1 = "واثناتان "
End If
Case "3"
c1 = "وثلاث "
Case "4"
c1 = "واربع "
Case "5"
c1 = "وخمس "
Case "6"
c1 = "وست "
Case "7"
c1 = "وسبع "
Case "8"
c1 = "وثمان "
Case "9"
c1 = "وتسع "
End Select
Else ' الريالات
Select Case a
Case "0"
c1 = ""
If c2 = "عشر " Then
c2 = "وعشرة "
End If
Case "1"
If c2 = "عشر " Then
c1 = "واحدى "
Else
c1 = "وواحد "
End If
Case "2"
If c2 = "عشر " Then
c1 = "واثنا "
Else
c1 = "واثنان "
End If
Case "3"
c1 = "وثلاثة "
Case "4"
c1 = "واربعة "
Case "5"
c1 = "وخمسة "
Case "6"
c1 = "وستة "
Case "7"
c1 = "وسبعة "
Case "8"
c1 = "وثمانة "
Case "9"
c1 = "وتسعة "
End Select
End If
zp = zp - 1
z = z + 1
Select Case zp
Case 9
Select Case c1 + c2 + c3
Case "وواحد "
xp = xp + "ومليون "
Case "واثنان "
xp = xp + "ومليونان"
Case Else
xp = xp + c3 + c1 + c2 + "مليون "
End Select
Case 6
Select Case c1 + c2 + c3
Case "وواحد "
xp = xp + "والف "
Case "واثنان "
xp = xp + "والفان "
Case "وثلاثة "
xp = xp + "وثلاثة الاف "
Case "واربعة "
xp = xp + "واربعة الاف "
Case "وخمسة "
xp = xp + "وخمسة الاف "
Case "وستة "
xp = xp + "وستة الاف "
Case "وسبعة "
xp = xp + "وسبعة الاف "
Case "وثمانية "
xp = xp + "وثمانية الاف "
Case "وتسعة "
xp = xp + "وتسعة الاف "
Case Else
If c2 = "وعشرة " Then
xp = xp + c3 + c1 + c2 + "الاف "
Else
xp = xp + c3 + c1 + c2 + "الف "
End If
End Select
Case 3
If c2 = "" Then
Select Case c1
Case "وواحد "
c1 = "وريالا "
Case "واثنان "
c1 = "وريالان "
Case "وثلاثة "
c1 = "وثلاثة ريالات "
Case "واربعة "
c1 = "واربعة ريالات "
Case "وخمسة "
c1 = "وخمسة ريالات "
Case "وستة "
c1 = "وستة ريالات "
Case "وسبعة "
c1 = "وسبعة ريالات "
Case "وثمانية "
c1 = "وثمانية ريالات "
Case "وتسعة "
c1 = "وتسعة ريالات "
End Select
xp = xp + c3 + c1 + c2
Else
xp = xp + c3 + c1 + c2 + "ريالاً "
End If
Case 0
If c1 + c2 <> "" Then
If c2 = "" Then
Select Case c1
Case "وواحد "
xp = xp + "وهلله واحده"
Case "واثنان "
xp = xp + "وهللتان "
Case Else
xp = xp + c1 + "هللات "
End Select
Else
xp = xp + c1 + c2 + "هللة "
End If
End If
End Select
Loop
xp = LTrim(xp)
zp = Len(xp) - 1
If Left(xp, 1) = "و" Then
xp = Mid(xp, 2, zp)
End If
ttpa = xp
write_Number = ttpa
End Function
من سار على الدرب وصل
الأخ مفرج
الله يعطيك العافية وقد جربت الكود الذي كتبته وهو ممتاز جداً وأقل تعقيد وأقل أسطر من الطريقة الثانية والتي تعمل نفس عملها .
أنا أول مرة الاحظ اسمك ، لا تحرمنا من الفوائد التي عندك ومشاركاتك بارك الله فيك .
ولك تحياتي
الأخ ابو حمود جزاك الله عنا خير الجزاء
لقد جربت الطريقة الأولى وهي تعمل بصورة ممتازة مع ملاحظة انه اذا كان العدداعلى من 9 خانات لايقبله ماهو السبب علماً انني لست بحاجة الى اكبر من 9 خانات ولكن للعلم فقط
لم أجرب هذا ولكن بعضها محدود بعدد معين .
والله يحفظك .
ولك تحياتي
الأخ العزيز مفرج
جربت الوحدة النمطية الخاصية بعملية التفقيط وكانت ممتاز وسهلة ولكن لاحظت عليها شيء وهو عند كتابة رقم 1000 يكون التفقيط ألف فقط دون التمييز ( ريال ) وكذالك الأرقام من 100 : 900 ومن 1000 إلى 9000 وهكذا وايضا كان يوجد نقص فى التعريفات فى السطر التالي
Dim ttpa, xp, zp, z, c1, c2, c3, a, number_s, fl As String
وعموما شكرا لك ولمجهوداتك وكما قال الأخ أبو حمود لا تحرمنا من مساعدتك
أخوكم / أشرف خليل
الاخوان جميعا يعطيكم الله الف عافيه
انا جربت الكود حق الاخ مفرج ممتاز جدا جدا بس ان فيه ملاحظه وهي عند 100 ومصاعفاتها لاتعطي ريال فوجدت المشكله هي فقط اضف هذا الكود:
Case ""
c1 = "ريال "
فقط وذلك في مكان في الحزء:
Select Case c1
Case "وواحد "
c1 = "وريالا "
Case "واثنان "
c1 = "وريالان "
Case "وثلاثة "
c1 = "وثلاثة ريالات "
Case "واربعة "
c1 = "واربعة ريالات "
Case "وخمسة "
c1 = "وخمسة ريالات "
Case "وستة "
c1 = "وستة ريالات "
Case "وسبعة "
c1 = "وسبعة ريالات "
Case "وثمانية "
c1 = "وثمانية ريالات "
Case "وتسعة "
c1 = "وتسعة ريالات "
End Select
وشكرا
اخي العزيز مفرج
جربت الكود الخاص بتحويل الارقام الى حروف
حيث قمت بنسخه من المنتدى ولصقه في وحدة نمطية لكن لم تظهر لي اي نتيجة .
حيث انني ارغب ان اكتب في النموذج رقم ويتم تحويله في التقرير الى كتابة.فماهي الطريقة السهلة لذلك
ارجو افاتي بصورة واضحة ومفصلة لاني جديد في البرمجة .
ولك شكري وتقديري
اخي بوحسن
اسف على التاخير
كتب في مصدر عنصر التحكم في الحقل الذي تريد كتابة النص فية هذه الجملة:
=write_Number(الرقم المطلوب)
ويمكن الاستعاضة عن الرقم المطلوب بالحقل الذي تريد كتابة نصه وكتب اسم الداله في الوحداة النمطية غير write_Number
وارجو لك ولجميع الزملاء في هذا المنتداالتوفيق
من سار على الدرب وصل
السلام عليكم
واسفين للتدخل وحنا نتعلم ياليت لو احد يعطيني طريقة الكودات هذي هل الصقها قي مكان معين ياليت لو تعلمونا وتكسبزن فينا الثواب وشكرا لكم
اخي الكريم
تلصق في الوحدات النمطية حتى يمكن استدعاءها من اي شاشة او تقرير في القاعدة
ارجو لك التوفيق
من سار على الدرب وصل
السلام عليكم ورحمة الله وبركاته
يتفق معي الجميع ان هذه الدالة مهمة جدة ولا يكاد يخلو برنامج محاسبي منها ولذلك اضعها بين يديكم لمن يرغب في استخدامها .
وهي تخدم من 0.01 الى 999.999.999.99
الدالة تتطلب منك ثلاث متغيرات
الاول من نوع Double وهو الرقم الذي تود تحويله
الثاني من نوع String وهو وحدة العملة الرئيسية
الثالث من نوع String وهو وحدة العملة الفرعية
وتعيد لك قيمة واحدة فقط وهو المبلغ مكتوبا بالاحرف.
الدالة
Function NoToTxt(TheNo As Double, MyCur As String, 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 Exit Function
If TheNo < 0 Then
TheNo = TheNo * -1
ReMark = "يتبقى لكم "
Else
ReMark = "فقط "
End If
If TheNo = 0 Then
NoToTxt = "صفر"
Exit Function
End If
MyAnd = " و"
MyArry1(0) = ""
MyArry1(1) = "مائة"
MyArry1(2) = "مائتان"
MyArry1(3) = "ثلاثمائة"
MyArry1(4) = "أربعمائة"
MyArry1(5) = "خمسمائة"
MyArry1(6) = "ستمائة"
MyArry1(7) = "سبعمائة"
MyArry1(8) = "ثمانمائة"
MyArry1(9) = "تسعمائة"
MyArry2(0) = ""
MyArry2(1) = " عشر"
MyArry2(2) = "عشرون"
MyArry2(3) = "ثلاثون"
MyArry2(4) = "أربعون"
MyArry2(5) = "خمسون"
MyArry2(6) = "ستون"
MyArry2(7) = "سبعون"
MyArry2(8) = "ثمانون"
MyArry2(9) = "تسعون"
MyArry3(0) = ""
MyArry3(1) = "واحد"
MyArry3(2) = "اثنان"
MyArry3(3) = "ثلاثة"
MyArry3(4) = "أربعة"
MyArry3(5) = "خمسة"
MyArry3(6) = "ستة"
MyArry3(7) = "سبعة"
MyArry3(8) = "ثمانية"
MyArry3(9) = "تسعة"
'======================
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 = "إحدى عشر"
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وتقبلوا تحياتي
الأخ أبو هاني
وفقك الله على مشاركات الطيبة النافعة التي استفاد منها الكثير .
هذا الموضوع مفيد جدا وهام ويحتاجه الكثير و قد كتب فيه عدة مرات ووضعت دوال كثيرة فيه .
ولك تحياتي
الأخ/ أبو هاني
جزاك الله كل خير على هذا المجهود.
ولدي ملاحظه ، كنت أتمنى أن توضح أين يمكن وضع الكود
هل يكتب بدخل "وحدة نمطية" أم بداخل "نموذج" ؟
لأن أمثالي قليلي الخبرة سوف يتيهون :confused: وسيصبح صعباً علينا
الإستفادة من الكود على الرغم من فائدته العظيمه.
ولك تحياتي.
اخي الكريم ابن مسقط
السلام عليكم ورحمة الله وبركاته
ضع الكود في وحدة نمطية وبعد ذلك يمكنك استدعائة من أي مكان في قاعدة البيانات
مثال :
الرقم موجود لديك في حقل Text1 وتريد ان تظهر الحروف في Text2
الان في حدث AfterUpdate لـ Text1 يمكنك مناداة الدالة المذكورة كالتالي :
Private Sub Text1_AfterUpdate() Text2= NoToTxt(Text2, "هللة", "ريال") End Sub
هذا كل ما في الامر ...
واذا استصعب عليك شي فانا تحت امرك
تحياتي
الأخ أبو هاني :
عفوا الكود الواجب وضعه فى حدث بعد التحديث هو ما يلي :
text2 = NoToTxt(text1, "ريال", "هلله")
أشرف خليل
اشكرك اخي ashraf على هذا التصيحيح
وفقك الله
هذا الموضوع مغلق.