CONVERSION MULTI-LANGUE DE NOMBRES EN TEXTE

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