ممكن مساعدة في تفقيط ارقام الى لغة الفرنسية
قمت تعديل على كود كان بلإنجليزية لكن هناك بعض اخطاء لم استطيع ان اعرف اين هيا
هدي هيا محاولتي لتعديل وشكرا
Option Compare Database
Option Explicit
Function ConvertCurrencyToEnglish(ByVal MyNumber)
Dim Temp
Dim dinars, Halals
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Mille "
Place(3) = " Million "
Place(4) = " Milliard "
Place(5) = " Billion "
' 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 Halals
Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
Halals = 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 Riyals.
Temp = ConvertHundreds(Right(MyNumber, 3))
If Temp <> "" Then dinars = Temp & Place(Count) & dinars
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 Riyals.
Select Case dinars
Case ""
'Riyals = "No Riyals"
Case "un"
dinars = " un dinars"
Case Else
dinars = dinars & " dinars"
End Select
' Clean up Halals.
Select Case Halals
Case ""
'Halals = " And No Halals"
Case "un"
Halals = " And Halalh"
Case Else
Halals = " And " & Halals & " Halals"
End Select
ConvertCurrencyToEnglish = dinars & Halals
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)) & " Cent "
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 = "Dix"
Case 11: Result = "Onze"
Case 12: Result = "Douze"
Case 13: Result = "treize"
Case 14: Result = "quatorze"
Case 15: Result = "Quinze"
Case 16: Result = "seize"
Case 17: Result = "dix sept"
Case 18: Result = "dix houit"
Case 19: Result = "dix neuf"
Case Else
End Select
Else
' .. otherwise it's between 20 and 99.
Select Case Val(Left(MyTens, 1))
Case 2: Result = "Vingt "
Case 3: Result = "Trente "
Case 4: Result = "Quarante "
Case 5: Result = "cinquante "
Case 6: Result = "Soixante "
Case 7: Result = "Soixante dix"
Case 8: Result = "Quatre-vingts "
Case 9: Result = "quatre vingt dix"
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 = "un"
Case 2: ConvertDigit = "deux"
Case 3: ConvertDigit = "trois"
Case 4: ConvertDigit = "quatre"
Case 5: ConvertDigit = "cinq"
Case 6: ConvertDigit = "Six"
Case 7: ConvertDigit = "Sept"
Case 8: ConvertDigit = "huit"
Case 9: ConvertDigit = "neuf"
Case Else: ConvertDigit = ""
End Select
End Function