• 0
slamc2000

تعديل تفقيط الأرقام بالدينار

سؤال

السلام عليكم ورحمة الله وبركاته
هل من الممكن مساعدتي في تعديل تفقيط الأرقام بالدينار
حيث إني أفتقد القراءة في الفاصلة العشرية الثالثة
وإذا ممكن وجود كلمة And من بعد الدينار
ولكم مني الشكر والتقدير

Option Compare Database

Option Explicit

Function ConvertCurrencyToEnglish(ByVal MyNumber)

  Dim Temp

         Dim Dinars, Fils

         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)

            Fils = ConvertTens(Temp)

            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

         End If

         Count = 1

         Do While MyNumber <> ""

            Temp = ConvertHundreds(Right(MyNumber, 3))

            If Temp <> "" Then Dinars = Temp & Place(Count) & Dinars

            If Len(MyNumber) > 3 Then

               MyNumber = Left(MyNumber, Len(MyNumber) - 3)

            Else

               MyNumber = ""

            End If

            Count = Count + 1

         Loop

         Select Case Dinars

            Case ""

               Dinars = "Zero Dinar"

            Case "One"

               Dinars = "One Dinar"

            Case Else

               Dinars = Dinars & " Dinars"

         End Select

         Select Case Fils

            Case ""

               Fils = " Zero Fils Only"

            Case "One"

               Fils = " And One Fils Only"

            Case Else

               Fils = " And " & Fils & " Fils Only"

         End Select

         ConvertCurrencyToEnglish = Dinars & Fils

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

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

1 إجابات على هذا السؤال .

  • 0

السلام عليكم و رحمة الله و بركاته

سوف اوافيك بالمطلوب غدا بعون الله تعالى

تم تعديل بواسطه mirage4pc
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان

  • يستعرض القسم حالياً   0 members

    لا يوجد أعضاء مسجلين يشاهدون هذه الصفحة .