اذهب الي المحتوي
أوفيسنا

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


yeslamb

الردود الموصى بها

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

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


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

تم تعديل بواسطه abu amir
رابط هذا التعليق
شارك

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

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

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

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

مع خالص تقدير

رابط هذا التعليق
شارك

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information