التفقيط بالانجليزي

[yeslamb]

أرجو من الإخوة الأفاضل التعديل ليصبح التفقيط بالانجليزي

شاكراً لكم سلفاً حسن تعاونكم

YESLAMB.zip

تم تعديل ديسمبر 5, 2008 بواسطه yeslamb

[abu amir]

اخي الكريم اتبع الخطوات التالية:

1- قم بتسمية حقل الرقم وحقل النص وعل وجه المثال A=الرقم B=النص

2- ضع الكود التالي بعد التحديث لحقل الرقم

b = ConvertCurrencyToEnglish(a)

3- ادرج الوحدة النمطية التالية باسم ConvertCurrencyTo WORDالى برنامجك

Option Compare Database
Option Explicit
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 "
         MyNumber = Trim(Str(MyNumber))
         DecimalPlace = InStr(MyNumber, ".")
        If DecimalPlace > 0 Then
         Temp = left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
            Cents = ConvertTens(Temp)
            MyNumber = Trim(left(MyNumber, DecimalPlace - 1))
         End If
         Count = 1
         Do While MyNumber <> ""
            Temp = ConvertHundreds(Right(MyNumber, 3))
            If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
            If Len(MyNumber) > 3 Then
               MyNumber = left(MyNumber, Len(MyNumber) - 3)
            Else
               MyNumber = ""
            End If
            Count = Count + 1
         Loop
         Select Case Dollars 'يمكنك وضع أي عملة تريدها بدلا من الدولار طبعا بالنجليزية
            Case ""
               Dollars = "No Dollars"
            Case "One"
               Dollars = "One Dollar"
            Case Else
               Dollars = Dollars & " Dollars"
         End Select
         Select Case Cents
         Case ""
         Cents = ""
           Case "One"
               Cents = " And One Cent"
            Case Else
               Cents = " And " & Cents & " Cents"
         End Select
         ConvertCurrencyToEnglish = Dollars & Cents
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
Private Function ConvertHundreds(ByVal MyNumber)
    Dim Result As String
         If Val(MyNumber) = 0 Then Exit Function
         MyNumber = Right("000" & MyNumber, 3)
         If left(MyNumber, 1) <> "0" Then
            Result = ConvertDigit(left(MyNumber, 1)) & " Hundred "
         End If
         If Mid(MyNumber, 2, 1) <> "0" Then
            Result = Result & ConvertTens(Mid(MyNumber, 2))
         Else
            Result = Result & ConvertDigit(Mid(MyNumber, 3))
         End If
         ConvertHundreds = Trim(Result)
End Function
Private Function ConvertTens(ByVal MyTens)
          Dim Result As String
         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

            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
            Result = Result & ConvertDigit(Right(MyTens, 1))
         End If
         ConvertTens = Result
End Function

وكل عام وانتم بخير

تم تعديل ديسمبر 7, 2008 بواسطه abu amir

[yeslamb]

أخي الفاضل أشكرك على تجاوبك

ولكن لم أفهم النقطة رقم واحد هل تقصد أن أضيف في الجدول حقلين باسم A والثاني باسم B

فقد عملت هذا وكملت الخطوات الأخرى ولكن تظهر لي رسالة بعد التحدبث

أرجو مساعدتي بالتعديل على النموذج الذي أرفقته مباشرة إن أمكن

مع خالص تقدير

[abu amir]

تفضل اخوي ملفك بعد التعديل

وكل عام وانتم بخير

YESLAMB.zip

[yeslamb]

أسال الله العظيم أن يجزيك خير الجزاء

دعوات في ظهر الغيب لكم على تجاوبكم السريع وتعاونكم الـ لا محدووووووووووووووووووووووووووووووووووووود

مرة أخرى لكم منى جزيل الشكر

استلمت التعديل وقمت ببعض التعديلات المتواضعة ليعمل بالريال وأيضاً أضفت جدول لتخزين البيانات فيه للرجوع إليها