Conversion multi-langue de nombres en texte

Soyez le premier à donner votre avis sur cette source.

Snippet vu 24 849 fois - Téléchargée 33 fois

Contenu du snippet

Dans le cadre d'une de mon application de gestion locative immobilière multilingue (Français, anglais, néerlandais, espagnol, allemand, italien...) qui est ImmoAssist (http://www.immoassist.com), je dois écrire des nombres en texte dans plusieures langues.

On trouve facilement pour l'anglais, le français, mais quid de l'espagnol, portugais, néerlandais....

Alors, voici, j'ai commencé à en écrire qque routines, elles ne sont pas encore optimizées, et peut-être qu'elles ont de petis bugs, alors, je propose à tout le monde de faire toutes les routines pour toutes les langues européennes, suivant les langues que chacun parle.

Source / Exemple :


Public Function NumberToTextDutch(sValue As String) As String
   ' #VBIDEUtils#************************************************************
   ' * Author           : Waty Thierry
   ' * Web Site         : http://www.vbdiamond.com
   ' * E-Mail           : waty.thierry@vbdiamond.com
   ' * Date             : 08/08/2005
   ' * Time             : 18:14
   ' * Module Name      : Lib_Module
   ' * Module Filename  : Lib.bas
   ' * Procedure Name   : NumberToTextDutch
   ' * Purpose          :
   ' * Parameters       :
   ' *                    sValue As String
   ' * Purpose          :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' * Example          :
   ' *
   ' * See Also         :
   ' *
   ' * History          :
   ' *
   ' *
   ' **********************************************************************

   ' #VBIDEUtilsERROR#
   On Error GoTo ERROR_NumberToTextDutch

   Static Ones(0 To 9) As String
   Static Teens(0 To 9) As String
   Static Tens(0 To 9) As String
   Static Thousands(0 To 4) As String

   Dim i                As Integer
   Dim nPosition        As Integer
   Dim ValNb            As Integer
   Dim LesZeros         As Integer
   Dim sResult          As String
   Dim sTemp            As String
   Dim tmpBuff          As String

   Dim strEn            As String   ' contains the value "en"
   Dim iParts           As Integer  ' number of portions of three digits in sValue
   Dim sParts(10)       As String   ' contains 3 digits, sParts(1) are the last three
   Dim j                As Integer  ' for next to loop thru sParts
   Dim sNLresult        As String   ' result for NL text
   
   strEn = "en"
   
   iParts = 1 ' must be one to maintain french when Langue <> "NL"
   sValue = Replace(sValue, " ", "")

   ' *** Splitting sValue in portions of 3 digits (or less for the last one)
   Do While True
      If Len(sValue) > 3 Then
         sParts(iParts) = right(sValue, 3)
         iParts = iParts + 1
         sValue = Mid(sValue, 1, Len(sValue) - 3)
      Else
         sParts(iParts) = sValue
         Exit Do
      End If
   Loop
   
   Ones(0) = "nul"
   Ones(1) = "een"
   Ones(2) = "twee"
   Ones(3) = "drie"
   Ones(4) = "vier"
   Ones(5) = "vijf"
   Ones(6) = "zes"
   Ones(7) = "zeven"
   Ones(8) = "acht"
   Ones(9) = "negen"

   Teens(0) = "tien"
   Teens(1) = "elf"
   Teens(2) = "twaalf"
   Teens(3) = "dertien"
   Teens(4) = "veertien"
   Teens(5) = "vijftien"
   Teens(6) = "zestien"
   Teens(7) = "zeventien"
   Teens(8) = "achtien"
   Teens(9) = "negentien"

   Tens(0) = vbNullString
   Tens(1) = "tien"
   Tens(2) = "twintig"
   Tens(3) = "dertig"
   Tens(4) = "veertig"
   Tens(5) = "vijftig"
   Tens(6) = "zestig"
   Tens(7) = "zeventig"
   Tens(8) = "tachtig"
   Tens(9) = "negentig"

   Thousands(0) = vbNullString
   Thousands(1) = "duizend"
   Thousands(2) = "miljoen"
   Thousands(3) = "miljard"
   Thousands(4) = "duizend"

   ' starting the loop thru sParts, if iparts = 1 then sValue = sPart(1)
   For j = 1 To iParts
      If iParts = 1 Then
         sTemp = CStr(Int(sValue))
      Else
         sTemp = CStr(Int(sParts(j)))
      End If

      For i = Len(sTemp) To 1 Step -1
         ValNb = Val(Mid$(sTemp, i, 1))
         nPosition = (Len(sTemp) - i) + 1
         Select Case (nPosition Mod 3)
            Case 1
               LesZeros = False
               If i = 1 Then
                  If ValNb > 0 Then '    original -> If ValNb > 1 Then  what i Changend  for one digit numbers
                     tmpBuff = Ones(ValNb) & " "
                  Else
                     tmpBuff = vbNullString
                  End If
               ElseIf Mid$(sTemp, i - 1, 1) = "1" Then
                  tmpBuff = Teens(ValNb) & " "
                  i = i - 1
               ElseIf Mid$(sTemp, i - 1, 1) = "9" Then
                  If Mid(sTemp, i, 1) <> 0 Then
                     tmpBuff = Ones(ValNb) & strEn & Tens(9) ' 91 to 99
                  Else
                     tmpBuff = Tens(9) ' 90
                  End If
                  i = i - 1
               ElseIf Mid$(sTemp, i - 1, 1) = "7" Then
                  If Mid(sTemp, i, 1) <> 0 Then
                     tmpBuff = Ones(ValNb) & strEn & Tens(7) '71 - 79
                  Else
                     tmpBuff = Tens(7) ' 70
                  End If
                  i = i - 1
               ElseIf ValNb > 0 Then
                  tmpBuff = Ones(ValNb) & " "
               Else
                  LesZeros = True
                  If i > 1 Then
                     If Mid$(sTemp, i - 1, 1) <> "0" Then
                        LesZeros = False
                     End If
                  End If
                  If i > 2 Then
                     If Mid$(sTemp, i - 2, 1) <> "0" Then
                        LesZeros = False
                     End If
                  End If
                  tmpBuff = vbNullString
               End If
               If LesZeros = False And nPosition > 1 Then
                  tmpBuff = tmpBuff & Thousands(nPosition / 3) & " "
               End If
               sResult = tmpBuff & sResult
            Case 2
               If ValNb > 0 Then
                  If Len(sResult) = 0 Then
                     sResult = Tens(ValNb)
                  Else
                     sResult = Trim(sResult) & strEn & Tens(ValNb)
                  End If
               End If
            Case 0
               If ValNb > 0 Then
                  If ValNb > 1 Then
                     sResult = Ones(ValNb) & "honderd" & sResult
                  Else
                     sResult = "honderd" & sResult
                  End If
               End If
         End Select
      Next i
      ' added for NL , to add the 1000, milj etc in front of
      ' the result
      If iParts > 1 And iParts <> j Then
         If j < iParts Then
            If sParts(j + 1) = "000" Then ' no adding of 1000, million etc
               sNLresult = sResult & sNLresult
            Else
               sNLresult = Thousands(j) & sResult & sNLresult
            End If
            sResult = "" ' emptying the sresult for NL
         End If
      Else
         sResult = sResult & sNLresult
      End If
   Next j
   If Len(sResult) > 0 Then
      sResult = UCase$(left$(sResult, 1)) & Mid$(sResult, 2)

   ElseIf sTemp = "0" Then
      sResult = Ones(0)

   End If

EXIT_NumberToTextDutch:
   NumberToTextDutch = Trim$(sResult)

   Exit Function

   ' #VBIDEUtilsERROR#
ERROR_NumberToTextDutch:
   sResult = vbNullString
   Resume EXIT_NumberToTextDutch
   
End Function

Public Function NumberToTextEnglish(sValue As String) As String
   ' #VBIDEUtils#************************************************************
   ' * Author           : Waty Thierry
   ' * Web Site         : http://www.vbdiamond.com
   ' * E-Mail           : waty.thierry@vbdiamond.com
   ' * Date             : 08/08/2005
   ' * Time             : 14:49
   ' * Module Name      : Lib_Module
   ' * Module Filename  : Lib.bas
   ' * Procedure Name   : NumberToTextEnglish
   ' * Purpose          :
   ' * Parameters       :
   ' *                    sValue As String
   ' * Purpose          :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' * Example          :
   ' *
   ' * See Also         :
   ' *
   ' * History          :
   ' *
   ' *
   ' **********************************************************************

   ' #VBIDEUtilsERROR#
   On Error GoTo ERROR_NumberToTextEnglish

   Static Ones(0 To 9) As String
   Static Teens(0 To 9) As String
   Static Tens(0 To 9) As String
   Static Thousands(0 To 4) As String
   Static bInit As Boolean
   Dim i                As Integer
   Dim bAllZeros        As Boolean
   Dim bShowThousands   As Boolean
   Dim sResult          As String
   Dim sBuff            As String
   Dim sTemp            As String
   Dim nCol             As Integer
   Dim nChar            As Integer

   ' *** Only handles positive values
   Debug.Assert sValue >= 0

   If bInit = False Then
      ' *** Initialize array
      bInit = True
      Ones(0) = "zero"
      Ones(1) = "one"
      Ones(2) = "two"
      Ones(3) = "three"
      Ones(4) = "four"
      Ones(5) = "five"
      Ones(6) = "six"
      Ones(7) = "seven"
      Ones(8) = "eight"
      Ones(9) = "nine"
      Teens(0) = "ten"
      Teens(1) = "eleven"
      Teens(2) = "twelve"
      Teens(3) = "thirteen"
      Teens(4) = "fourteen"
      Teens(5) = "fifteen"
      Teens(6) = "sixteen"
      Teens(7) = "seventeen"
      Teens(8) = "eighteen"
      Teens(9) = "nineteen"
      Tens(0) = ""
      Tens(1) = "ten"
      Tens(2) = "twenty"
      Tens(3) = "thirty"
      Tens(4) = "forty"
      Tens(5) = "fifty"
      Tens(6) = "sixty"
      Tens(7) = "seventy"
      Tens(8) = "eighty"
      Tens(9) = "ninety"
      Thousands(0) = ""
      Thousands(1) = "thousand"   'US numbering
      Thousands(2) = "million"
      Thousands(3) = "billion"
      Thousands(4) = "trillion"
   End If
   
   ' *** Get fractional part
   sBuff = vbNullString '"and " & Format((sValue - Int(sValue)) * 100, "00") & "/100"
   
   ' *** Convert rest to string and process each digit
   sResult = CStr(Int(sValue))
   
   ' *** Non-zero digit not yet encountered
   bAllZeros = True
   
   ' *** Iterate through string
   For i = Len(sResult) To 1 Step -1
      '*** Get value of this digit
      nChar = Val(Mid$(sResult, i, 1))
      
      ' *** Get column position
      nCol = (Len(sResult) - i) + 1
      
      ' *** Action depends on 1's, 10's or 100's column
      Select Case (nCol Mod 3)
         Case 1  '1's position
            bShowThousands = True
            If i = 1 Then
               ' *** First digit in number (last in loop)
               sTemp = Ones(nChar) & " "
            ElseIf Mid$(sResult, i - 1, 1) = "1" Then
               ' *** This digit is part of "teen" number
               sTemp = Teens(nChar) & " "
               i = i - 1   'Skip tens position
            ElseIf nChar > 0 Then
               ' *** Any non-zero digit
               sTemp = Ones(nChar) & " "
            Else
               ' *** This digit is zero. If digit in tens and hundreds column are also zero, don't show "thousands"
               bShowThousands = False
               
               ' *** Test for non-zero digit in this grouping
               If Mid$(sResult, i - 1, 1) <> "0" Then
                  bShowThousands = True
               ElseIf i > 2 Then
                  If Mid$(sResult, i - 2, 1) <> "0" Then
                     bShowThousands = True
                  End If
               End If
               sTemp = ""
            End If
            
            ' *** Show "thousands" if non-zero in grouping
            If bShowThousands Then
               If nCol > 1 Then
                  sTemp = sTemp & Thousands(nCol \ 3)
                  If bAllZeros Then
                     sTemp = sTemp & " "
                  Else
                     sTemp = sTemp & ", "
                  End If
               End If
               
               ' *** Indicate non-zero digit encountered
               bAllZeros = False
            End If
            sBuff = sTemp & sBuff
         Case 2  '10's position
            If nChar > 0 Then
               If Mid$(sResult, i + 1, 1) <> "0" Then
                  sBuff = Tens(nChar) & "-" & sBuff
               Else
                  sBuff = Tens(nChar) & " " & sBuff
               End If
            End If
         Case 0  '100's position
            If nChar > 0 Then
               sBuff = Ones(nChar) & " hundred " & sBuff
            End If
      End Select
   Next i
   
   ' *** Convert first letter to upper case
   sBuff = UCase$(left$(sBuff, 1)) & Mid$(sBuff, 2)
   
EXIT_NumberToTextEnglish:
   ' *** Return result
   NumberToTextEnglish = sBuff

   Exit Function

   ' #VBIDEUtilsERROR#
ERROR_NumberToTextEnglish:
   Resume EXIT_NumberToTextEnglish

End Function

Public Function NumberToTextFrench(sValue As String, Optional nPays As Integer = 0) As String
   ' #VBIDEUtils#************************************************************
   ' * Author           : Waty Thierry
   ' * Web Site         : http://www.vbdiamond.com
   ' * E-Mail           : waty.thierry@vbdiamond.com
   ' * Date             : 02/26/2003
   ' * Project Name     : ImmoAssist
   ' * Module Name      : Lib_Module
   ' * Module Filename  : Lib.bas
   ' * Procedure Name   : NumberToTextFrench
   ' * Purpose          :
   ' * Parameters       :
   ' *                    sValue As String
   ' *                    Optional nPays As Integer = 0
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' * Example          :
   ' *
   ' * Screenshot       :
   ' *
   ' * See Also         :
   ' *
   ' * History          :
   ' *
   ' *
   ' **********************************************************************

   ' #VBIDEUtilsERROR#
   On Error GoTo ERROR_NumberToTextFrench

   Static Ones(0 To 9) As String
   Static Teens(0 To 9) As String
   Static Tens(0 To 9) As String
   Static Thousands(0 To 5) As String

   Dim i                As Integer
   Dim nPosition        As Integer
   Dim ValNb            As Integer
   Dim LesZeros         As Integer
   Dim sResult          As String
   Dim sTemp            As String
   Dim tmpBuff          As String

   Ones(0) = "zéro"
   Ones(1) = "un"
   Ones(2) = "deux"
   Ones(3) = "trois"
   Ones(4) = "quatre"
   Ones(5) = "cinq"
   Ones(6) = "six"
   Ones(7) = "sept"
   Ones(8) = "huit"
   Ones(9) = "neuf"

   Teens(0) = "dix"
   Teens(1) = "onze"
   Teens(2) = "douze"
   Teens(3) = "treize"
   Teens(4) = "quatorze"
   Teens(5) = "quinze"
   Teens(6) = "seize"
   Teens(7) = "dix-sept"
   Teens(8) = "dix-huit"
   Teens(9) = "dix-neuf"

   Tens(0) = vbNullString
   Tens(1) = "dix"
   Tens(2) = "vingt"
   Tens(3) = "trente"
   Tens(4) = "quarante"
   Tens(5) = "cinquante"
   Tens(6) = "soixante"
   Select Case nPays
      Case 0
         ' *** France
         Tens(7) = "soixante-dix"
         Tens(8) = "quatre-vingt"
         Tens(9) = "quatre-vingt-dix"
      
      Case 1
         ' *** Belgium
         Tens(7) = "septante"
         Tens(8) = "quatre-vingt"
         Tens(9) = "nonante"
      
      Case 2
         ' *** Suisse
         Tens(7) = "septante"
         Tens(8) = "octante"
         Tens(9) = "nonante"
      
   End Select

   Thousands(0) = vbNullString
   Thousands(1) = "mille"
   Thousands(2) = "million"
   Thousands(3) = "millard"
   Thousands(4) = "billion"

   sTemp = CStr(Int(sValue))

   For i = Len(sTemp) To 1 Step -1
      ValNb = Val(Mid$(sTemp, i, 1))
      nPosition = (Len(sTemp) - i) + 1
      Select Case (nPosition Mod 3)
         Case 1
            LesZeros = False
            If i = 1 Then
               If ValNb > 1 Then
                  tmpBuff = Ones(ValNb) & " "
               Else
                  tmpBuff = vbNullString
               End If
            ElseIf Mid$(sTemp, i - 1, 1) = "1" Then
               tmpBuff = Teens(ValNb) & " "
               i = i - 1
            ElseIf Mid$(sTemp, i - 1, 1) = "9" Then
               If nPays = 0 Then
                  tmpBuff = Tens(8) & " " & Teens(ValNb) & " "
               Else
                  tmpBuff = Tens(9) & " "
                  If ValNb > 0 Then tmpBuff = tmpBuff & IIf(ValNb = 1, "et ", "") & Ones(ValNb) & " "
               End If
               i = i - 1
            ElseIf Mid$(sTemp, i - 1, 1) = "7" Then
               If nPays = 0 Then
                  tmpBuff = Tens(6) & " " & Teens(ValNb) & " "
               Else
                  tmpBuff = Tens(7) & " "
                  If ValNb > 0 Then tmpBuff = tmpBuff & IIf(ValNb = 1, "et ", "") & Ones(ValNb) & " "
               End If
               i = i - 1
            ElseIf ValNb > 0 Then
               tmpBuff = Ones(ValNb) & " "
            Else
               LesZeros = True
               If i > 1 Then
                  If Mid$(sTemp, i - 1, 1) <> "0" Then
                     LesZeros = False
                  End If
               End If
               If i > 2 Then
                  If Mid$(sTemp, i - 2, 1) <> "0" Then
                     LesZeros = False
                  End If
               End If
               tmpBuff = vbNullString
            End If
            If LesZeros = False And nPosition > 1 Then
               tmpBuff = tmpBuff & Thousands(nPosition / 3) & " "
            End If
            sResult = tmpBuff & sResult
         Case 2
            If ValNb > 0 Then
               sResult = Tens(ValNb) & " " & sResult
            End If
         Case 0
            If ValNb > 0 Then
               If ValNb > 1 Then
                  sResult = Ones(ValNb) & " cent " & sResult
               Else
                  sResult = "cent " & sResult
               End If
            End If
      End Select
   Next i

   If Len(sResult) > 0 Then
      sResult = UCase$(left$(sResult, 1)) & Mid$(sResult, 2)

   ElseIf sTemp = "0" Then
      sResult = Ones(0)

   End If

   NumberToTextFrench = Trim$(sResult)

EXIT_NumberToTextFrench:
   Exit Function

   ' #VBIDEUtilsERROR#
ERROR_NumberToTextFrench:
   sResult = vbNullString
   Resume EXIT_NumberToTextFrench

End Function

Public Function NumberToTextSpanish(sValue As String) As String
   ' #VBIDEUtils#************************************************************
   ' * Author           : Waty Thierry
   ' * Web Site         : http://www.vbdiamond.com
   ' * E-Mail           : waty.thierry@vbdiamond.com
   ' * Date             : 08/08/2005
   ' * Time             : 18:13
   ' * Module Name      : Lib_Module
   ' * Module Filename  : Lib.bas
   ' * Procedure Name   : NumberToTextSpanish
   ' * Purpose          :
   ' * Parameters       :
   ' *                    sValue As String
   ' * Purpose          :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' * Example          :
   ' *
   ' * See Also         :
   ' *
   ' * History          :
   ' *
   ' *
   ' **********************************************************************

   ' #VBIDEUtilsERROR#
   On Error GoTo ERROR_NumberToTextSpanish

   Static Ones(0 To 9) As String
   Static Teens(0 To 9) As String
   Static Tens(0 To 9) As String
   Static Thousands(0 To 5) As String
   Static dup_Thousands(0 To 5) As String

   Dim i                As Integer
   Dim nPosition        As Integer
   Dim ValNb            As Integer
   Dim LesZeros         As Integer
   Dim sResult          As String
   Dim sTemp            As String
   Dim tmpBuff          As String

   Dim bAllZeros        As Boolean
   Dim bShow1000        As Boolean
   Dim bNintyNines      As Boolean

   Dim sReturn          As String
   Dim sBuff            As String

   Dim nCol             As Long
   Dim nChar            As Long

   bNintyNines = True

   bAllZeros = False
   bShow1000 = False

   Ones(0) = "cero"
   Ones(1) = "uno"
   Ones(2) = "dos"
   Ones(3) = "tres"
   Ones(4) = "cuatro"
   Ones(5) = "cinco"
   Ones(6) = "seis"
   Ones(7) = "siete"
   Ones(8) = "ocho"
   Ones(9) = "nueve"

   Teens(0) = "diez"
   Teens(1) = "once"
   Teens(2) = "doce"
   Teens(3) = "trece"
   Teens(4) = "catorce"
   Teens(5) = "quince"
   Teens(6) = "dieciseis"
   Teens(7) = "diecisiete"
   Teens(8) = "dieciocho"
   Teens(9) = "diecinueve"

   Tens(0) = vbNullString
   Tens(1) = "diez"
   Tens(2) = "veinte"
   Tens(3) = "treinta"
   Tens(4) = "cuarenta"
   Tens(5) = "cincuenta"
   Tens(6) = "sesenta"
   Tens(7) = "setenta"
   Tens(8) = "ochenta"
   Tens(9) = "noventa"

   Thousands(0) = vbNullString
   Thousands(1) = "mil"
   Thousands(2) = "million"
   Thousands(3) = "mil million"
   Thousands(4) = "billion"
   Thousands(5) = "trillion"
   
   dup_Thousands(0) = vbNullString
   dup_Thousands(1) = "mil"
   dup_Thousands(2) = "milliones"
   dup_Thousands(3) = "mil milliones"
   dup_Thousands(4) = "billiones"
   dup_Thousands(5) = "trilliones"
   
   sValue = Replace(sValue, " ", "")
   
   If IsNumeric(sValue) = False Then Exit Function

   sReturn = sValue
   bAllZeros = True
   For i = Len(sReturn) To 1 Step -1
      nChar = CInt(Mid(sReturn, i, 1))
      nCol = (Len(sReturn) - i) + 1
      Select Case (nCol Mod 3)
         Case 1  '1'
            bShow1000 = True
            If i = 1 Then
               If nChar = 1 Then
                  Select Case nCol
                     Case 1
                        sTemp = IIf(nCol = 1, "uno ", "un ")
                     Case 4
                        sTemp = ""
                     Case Else
                        sTemp = "Un "
                  End Select
               Else
                  sTemp = Ones(nChar) & " "
               End If
               If nChar > 1 Then
                  bNintyNines = True
               End If
            ElseIf Mid(sReturn, i - 1, 1) = "1" Then
               sTemp = Teens(nChar) & " "
               i = i - 1   'Skip
               bNintyNines = True
            ElseIf nChar > 0 Then
               sTemp = IIf(nChar = 1, IIf(nCol = 1, "Uno ", "Un "), Ones(nChar) & " ")
               bNintyNines = True
            Else

               bShow1000 = False
               If Mid(sReturn, i - 1, 1) <> "0" Then
                  bShow1000 = True
               ElseIf i > 2 Then
                  If Mid(sReturn, i - 2, 1) <> "0" Then
                     bShow1000 = True
                  End If
               End If
               sTemp = ""
               bNintyNines = False
            End If
            If bShow1000 Then
               If nCol > 1 Then
                  If nCol \ 3 > 5 Then
                     sTemp = sTemp & IIf(nChar > 1, dup_Thousands(5), Thousands(5))
                  Else
                     sTemp = sTemp & IIf(nChar > 1, dup_Thousands(nCol \ 3), Thousands(nCol \ 3))
                  End If
                  If bAllZeros Then sTemp = sTemp & " "
               End If
               bAllZeros = False
            End If
            sBuff = sTemp & sBuff
         Case 2  '10'
            If nChar > 0 Then
               If Mid(sReturn, i + 1, 1) <> "0" Then
                  sBuff = Tens(nChar) & " y " & sBuff
               Else
                  sBuff = Tens(nChar) & " " & sBuff
               End If
               If Not bNintyNines Then
                  bNintyNines = True
               End If
            End If
         Case 0  '100'
            If nChar > 0 Then
               If nChar = 1 Then
                  If bNintyNines Then
                     sBuff = " ciento " & sBuff
                     bNintyNines = False
                  Else
                     sBuff = " cien " & sBuff
                     bNintyNines = False
                  End If
               Else
                  If nChar = 5 Then
                     sBuff = "quinientos " & sBuff
                  Else
                     sBuff = Ones(nChar) & "cientos " & sBuff
                  End If
               End If
            End If
      End Select
   Next
   sBuff = Trim$(sBuff)
   sBuff = UCase(left$(sBuff, 1)) & Mid(sBuff, 2)

EXIT_NumberToTextSpanish:
   NumberToTextSpanish = sBuff
   Exit Function

   ' #VBIDEUtilsERROR#
ERROR_NumberToTextSpanish:
   sBuff = vbNullString
   Resume EXIT_NumberToTextSpanish

End Function

Conclusion :


? NumberToTextFrench(1234560) (et les autres langues)

Million deux cent trente quatre mille cinq cent soixante
Een miljoentweehonderdvierendertigduizendvijfhonderdzestig
One million, two hundred thirty-four thousand, five hundred sixty
Un milliondoscientos treinta y cuatro milquinientos sesenta
Uno milione due cento trentaquattro mille cinque cento sessanta
Um milhão duzentos e trinta e quatro mile quinhentos e sessenta reais

A voir également

Ajouter un commentaire Commentaires
Messages postés
16
Date d'inscription
vendredi 7 novembre 2003
Statut
Membre
Dernière intervention
23 juin 2006

Malgré les quelques problèmes déjà cités en français (d'autres source sur le site proposent des solutions les corrigeant), on peut quand même dire bravo pour l'idée. Il semble en tout cas que le français soit vraiment le plus difficile pour ce problème; les autres langues ne présentant pas autant d'exceptions. Le multilingue est particulièrement utile ici où un simple dictionnaire ne suffit pas !
Je cherchais justement cela.
Merci.
Messages postés
251
Date d'inscription
lundi 29 mars 2004
Statut
Membre
Dernière intervention
4 mars 2008
1
ERREUR DANS MON TEXTE

Second paragraphe :
Deuxièmement, si je demande NumberToTextFrench(1238465), j'obtiens "quatre-vingt" et non pas "quatre-vingts" qui est l'écriture correcte (manquant : le s de la règle de grammaire de vingt et cent, d'où ; pareil avec NumberToTextFrench(200) qui donne "Deux cent" et non pas "Deux cents").

Merci de lire :
Deuxièmement, si je demande NumberToTextFrench(80), j'obtiens "quatre-vingt" et non pas "quatre-vingts" qui est l'écriture correcte (manquant : le s de la règle de grammaire de vingt et cent, d'où ; pareil avec NumberToTextFrench(200) qui donne "Deux cent" et non pas "Deux cents").
Messages postés
251
Date d'inscription
lundi 29 mars 2004
Statut
Membre
Dernière intervention
4 mars 2008
1
Salut !

Il y avait déjà de telles sources sur le site, mais il est vrai monolingues. La force de celle-ci, c'est de proposer une conversion dans plusieurs langues. CEPENDANT, il y a plusieurs problèmes au niveau du français.

Lorsque je demande NumberToTextFrench(1238465), j'obtiens : "Million deux cent trente huit mille quatre cent soixante cinq", alors que la chaîne correcte est : "un million deux cent trente-huit mille quatre cent soixante-cinq" (manquants : "un" antéposé et traits d'union)

Deuxièmement, si je demande NumberToTextFrench(1238465), j'obtiens "quatre-vingt" et non pas "quatre-vingts" qui est l'écriture correcte (manquant : le s de la règle de grammaire de vingt et cent, d'où ; pareil avec NumberToTextFrench(200) qui donne "Deux cent" et non pas "Deux cents").

Côté programmation, il y a peu de commentaires, ce qui est un peu dommage car, même facile, ce code est long. Moi je mets 7.

Cordialement,
Cacophrène
Messages postés
12
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
20 février 2006

Dutch = Néerlandais

Pour le zip, on pourrait le faire après

Voici la version portuguese

Public Function NumberToTextPortuguese(sValue As String) As String
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.vbdiamond.com
' * E-Mail : waty.thierry@vbdiamond.com
' * Date : 08/08/2005
' * Time : 18:13
' * Module Name : Lib_Module
' * Module Filename : Lib.bas
' * Procedure Name : NumberToTextPortuguese
' * Purpose :
' * Parameters :
' * sValue As String
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************

' #VBIDEUtilsERROR#
On Error GoTo ERROR_NumberToTextPortuguese

Dim n(900) As String
Dim MOEDA As String
Dim Numero As Double

n(1) = "um "
n(2) = "dois "
n(3) = "tres "
n(4) = "quatro "
n(5) = "cinco "
n(6) = "seis "
n(7) = "sete "
n(8) = "oito "
n(9) = "nove "
n(10) = "dez "
n(11) = "onze "
n(12) = "doze "
n(13) = "treze "
n(14) = "quatorze "
n(15) = "quinze "
n(16) = "dezesseis "
n(17) = "dezessete "
n(18) = "dezoito "
n(19) = "dezenove "
n(20) = "vinte "
n(30) = "trinta "
n(40) = "quarenta "
n(50) = "cinquenta "
n(60) = "sessenta "
n(70) = "setenta "
n(80) = "oitenta "
n(90) = "noventa "
n(100) = "cem "
n(200) = "duzentos "
n(300) = "trezentos "
n(400) = "quatrocentos "
n(500) = "quinhentos "
n(600) = "seiscentos "
n(700) = "setecentos "
n(800) = "oitocentos "
n(900) = "novecentos "
MOEDA = vbNullString

NumberToTextPortuguese = vbNullString

sValue = Replace(sValue, " ", vbNullString)
If IsNumeric(sValue) = False Then Exit Function

' *** MILHOES
Numero = Int((sValue / 1000000))
If Numero > 0 Then
MOEDA = "de reais "
' *** CENTENA DE MILHOES
If Numero > 99 Then

' *** VERIFICA SE TEM A LETRA "E"
If Numero > 100 Then
If Int(Numero / 100) = 1 Then
If Numero - (Int(Numero / 100) * 100) = 0 Then
NumberToTextPortuguese = NumberToTextPortuguese & "cem "
Else
NumberToTextPortuguese = NumberToTextPortuguese & "cento e "
End If
Else
If Numero - (Int(Numero / 100) * 100) = 0 Then
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 100) * 100)
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 100) * 100) & "e "
End If
End If
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 100) * 100)
End If
End If

' *** DEZENA DE MILHOES
Numero = Numero - (Int(Numero / 100) * 100)
If Numero > 9 Then

' *** VERIFICA SE TEM A LETRA "E"
If Numero > 10 Then
If Numero - (Int(Numero / 10) * 10) = 0 Or (Numero > 10 And Numero < 20) Then
NumberToTextPortuguese = NumberToTextPortuguese & n(Numero)
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 10) * 10) & "e "
End If
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Numero)
End If
End If

' *** UNIDADE DE MILHOES
If Numero < 10 Or Numero > 19 Then
Numero = Numero - (Int(Numero / 10) * 10)
If Numero > 0 Then
NumberToTextPortuguese = NumberToTextPortuguese & n(Numero)
End If
End If
If Numero = 1 Then
NumberToTextPortuguese = NumberToTextPortuguese & "milhão "
Else
NumberToTextPortuguese = NumberToTextPortuguese & "milhão "
End If
End If

' *** MILHARES
Numero = Int((sValue / 1000)) - (Int((sValue / 1000000)) * 1000)

If Numero > 0 Then
MOEDA = "reais "
' *** CENTENA DE MILHARES
If Numero > 99 Then

' *** VERIFICA SE TEM A LETRA "E"
If Numero > 100 Then
If Int(Numero / 100) = 1 Then
If Numero - (Int(Numero / 100) * 100) = 0 Then
NumberToTextPortuguese = NumberToTextPortuguese & "cem "
Else
NumberToTextPortuguese = NumberToTextPortuguese & "cento e "
End If
Else
If Numero - (Int(Numero / 100) * 100) = 0 Then
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 100) * 100)
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 100) * 100) & "e "
End If
End If
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 100) * 100)
End If
End If

' *** DEZENA DE MILHARES
Numero = Numero - (Int(Numero / 100) * 100)
If Numero > 9 Then

' *** VERIFICA SE TEM A LETRA "E"
If Numero > 10 Then
If Numero - (Int(Numero / 10) * 10) = 0 Or (Numero > 10 And Numero < 20) Then
NumberToTextPortuguese = NumberToTextPortuguese & n(Numero)
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 10) * 10) & "e "
End If
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Numero)
End If
End If

' *** UNIDADE DE MILHARES
If Numero < 10 Or Numero > 19 Then
Numero = Numero - (Int(Numero / 10) * 10)
If Numero > 0 Then
NumberToTextPortuguese = NumberToTextPortuguese & n(Numero)
End If
End If
NumberToTextPortuguese = NumberToTextPortuguese & "mil"

End If

Numero = Int(sValue)

' *** CENTENAS
Numero = Int(sValue) - Int(sValue / 1000000) * 1000000
Numero = Int(sValue) - Int(sValue / 1000) * 1000

If Numero > 0 Then
If Len(NumberToTextPortuguese) > 0 Then
NumberToTextPortuguese = NumberToTextPortuguese & "e "
End If
MOEDA = "reais "
' *** CENTENA
If Numero > 99 Then

' *** VERIFICA SE TEM A LETRA "E"
If Numero > 100 Then
If Int(Numero / 100) = 1 Then
If Numero - (Int(Numero / 100) * 100) = 0 Then
NumberToTextPortuguese = NumberToTextPortuguese & "cem "
Else
NumberToTextPortuguese = NumberToTextPortuguese & "cento e "
End If
Else
If Numero - (Int(Numero / 100) * 100) = 0 Then
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 100) * 100)
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 100) * 100) & "e "
End If
End If
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 100) * 100)
End If
End If

' *** DEZENA
Numero = Numero - (Int(Numero / 100) * 100)
If Numero > 9 Then

' *** VERIFICA SE TEM A LETRA "E"
If Numero > 10 Then
If Numero - (Int(Numero / 10) * 10) = 0 Or (Numero > 10 And Numero < 20) Then
NumberToTextPortuguese = NumberToTextPortuguese & n(Numero)
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 10) * 10) & "e "
End If
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Numero)
End If
End If

' *** UNIDADE
If Numero < 10 Or Numero > 19 Then
Numero = Numero - (Int(Numero / 10) * 10)
If Numero > 0 Then
NumberToTextPortuguese = NumberToTextPortuguese & n(Numero)
End If
End If

End If

If sValue = 1 Then
NumberToTextPortuguese = NumberToTextPortuguese & "real "
Else
NumberToTextPortuguese = NumberToTextPortuguese & MOEDA
End If

' *** CENTAVOS
Numero = Int(Round(sValue - Int(sValue), 2) * 100)

If Numero > 0 Then
If Len(NumberToTextPortuguese) > 0 Then
NumberToTextPortuguese = NumberToTextPortuguese & "e "
End If
' *** DEZENA
Numero = Numero - (Int(Numero / 100) * 100)
If Numero > 9 Then

' *** VERIFICA SE TEM A LETRA "E"
If Numero > 10 Then
If Numero - (Int(Numero / 10) * 10) = 0 Or (Numero > 10 And Numero < 20) Then
NumberToTextPortuguese = NumberToTextPortuguese & n(Numero)
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Int(Numero / 10) * 10) & "e "
End If
Else
NumberToTextPortuguese = NumberToTextPortuguese & n(Numero)
End If
End If

' *** UNIDADE
If Numero < 10 Or Numero > 19 Then
Numero = Numero - (Int(Numero / 10) * 10)
If Numero > 0 Then
NumberToTextPortuguese = NumberToTextPortuguese & n(Numero)
End If
End If
If Numero = 1 Then
NumberToTextPortuguese = NumberToTextPortuguese & "centavo"
Else
NumberToTextPortuguese = NumberToTextPortuguese & "centavos "
End If

End If

EXIT_NumberToTextPortuguese:
NumberToTextPortuguese = UCase(Left$(NumberToTextPortuguese, 1)) & Mid(NumberToTextPortuguese, 2)
Exit Function

' #VBIDEUtilsERROR#
ERROR_NumberToTextPortuguese:

End Function
Messages postés
214
Date d'inscription
jeudi 10 mars 2005
Statut
Membre
Dernière intervention
12 avril 2008

c'est une tès bonne idée je trouve et le programme est clair
Afficher les 7 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.