تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[سؤال] الرجاء شرح الدالة التالية
#1
Option Compare Database
Option Explicit

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
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 'less than billion
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
الرد }}}}
تم الشكر بواسطة:
#2
الرجاء شرح لكل تعليمة بالدالة
الرد }}}}
تم الشكر بواسطة:
#3
الرجاء من الاخ الكريم شرح تفصيلي لكل تعليمة بالدالة
الرد }}}}
تم الشكر بواسطة:
#4
ده كود تحويل الارقام الى حروف

يسمى كود التفقيط ، مثلا عندك رقم 15300 الكود يحوله كالتالى خمسة عشر الفا وثلاثمائة

كود :
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
الرد }}}}
تم الشكر بواسطة:
#5
بالتوفيق اخى الكريم ...

..........
الرد }}}}
تم الشكر بواسطة:
#6
ممكن افهم شو I+1
ليش احيانا I+2
الرد }}}}
تم الشكر بواسطة:
#7
عندما تبدع انامل العرب!!!!!!!!!!!!
وين الابداع ازا كود ما عم يعرفوا يشرحوه؟؟؟؟؟؟؟؟؟؟؟؟
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  الرجاء مساعدتى فى المعادله التالية Ashraf Elafify 5 192 21-04-16, 02:38 PM
آخر رد: Ashraf Elafify
  الرجاء المساعدة في كود تعديل البست فيو فاضل الحمود 8 366 27-09-15, 02:08 PM
آخر رد: فاضل الحمود
  الرجاء التعديل على المثال الرسم البياني UserControl eng_ahmedsamir3 3 537 20-03-15, 08:04 PM
آخر رد: abulayth
  حد عنده افكار في الدالة دي superwoofer 0 259 07-02-15, 09:43 PM
آخر رد: superwoofer
  [سؤال] الرجاء من الجميع مساعدتي عاجلا الله يحفظكم aboali76 4 459 28-09-14, 12:30 AM
آخر رد: السيد الغالي
  كود حذف الصنف في الفاتورة لايعمل الرجاء التعديل فاضل الحمود 6 639 22-09-14, 01:53 PM
آخر رد: فاضل الحمود
  [كود] الرجاء تعديل كود البحث في المرفقات وشكرا فاضل الحمود 4 436 18-08-14, 09:16 AM
آخر رد: فاضل الحمود
Exclamation [سؤال] الرجاء المساعدة في شرح بعض الاكواد مبرمج صغير 2 559 12-05-14, 04:45 PM
آخر رد: مبرمج صغير
  الرجاء المساعدة في تعديل المثال المرفق eng_ahmedsamir3 2 484 12-03-14, 11:34 AM
آخر رد: eng_ahmedsamir3
  ارجو المساعدة فى عمل هذه الدالة wolf1120 1 467 28-01-14, 04:02 PM
آخر رد: ناجي إبراهيم

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


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