[VB6] Conversion de chiffres en lettres

Public Function sumLetter(ByVal argument As Currency) As String Dim integer As Double Dim cents As Double Dim result1 As String Dim result2 As String integer = Int(argument) ' Integer value cents = (argument - integer) * 100 ' Cents value result1 = sumLet2(integer) result2 = sumLet2(cents) If Trim(result1) <> "" Then result1 = result1 & " Dinars " End If If Trim(result2) <> "" Then result2 = result2 & " Cts" End If sumLetter = result1 & " and " & result2 End Function '************************************************************* ' Function to convert numbers to words '************************************************************* Public Function sumLet2(ByVal argument As Double) As String Dim letters As Variant Dim units As Variant Dim tens As Variant Dim hundreds As Variant Dim unit As Integer Dim ten As Integer Dim hundred As Integer Dim groups As Variant Dim string As String Dim ng, nc As Integer Dim i, j, k As Integer Dim xx As String string = Trim(Str(argument)) nc = Len(string) ' Number of digits letters = Array("", "thousand", "million", "billion", "trillion") units = Array("", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen") tens = Array("", "ten", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety") hundreds = Array("", "hundred", "two hundred", "three hundred", "four hundred", "five hundred", "six hundred", "seven hundred", "eight hundred", "nine hundred") If argument = 0 Then sumLet2 = "" Else If nc Mod 3 > 0 Then ng = Int(nc / 3) + 1 ' Number of groups Else ng = nc / 3 End If ReDim groups(ng - 1) string = String(ng * 3 - nc, " ") & string nc = Len(string) j = 0 For i = nc To 1 Step -3 xx = Mid(string, i - 2, i) groups(j) = xx j = j + 1 Next string = "" For j = 0 To UBound(groups) unit = Val(Mid(groups(j), 3, 1)) ten = Val(Mid(groups(j), 2, 1)) If ten = 1 Or ten = 7 Or ten = 9 Then ten = ten - 1 unit = unit + 10 End If hundred = Val(Mid(groups(j), 1, 1)) string = hundreds(hundred) & " " & tens(ten) & " " & units(unit) & " " & letters(j) & " " & string Next sumLet2 = string End If End Function

Function NBenLettres(nb) ' Dim varnum, varnumD, varnumU, varlet ', result ' 'varnum : to store the parts of the number that we will cut 'varlet : to store the conversion to letters of a part of the number 'varnumD : to store the tens part of a 2-digit number 'varnumU : to store the units part of a 2-digit number 'result : to store the intermediate results of the different steps ' Static chiffre(1 To 19) '*** array containing the names of the first 16 numbers in letters chiffre(1) = "one" chiffre(2) = "two" chiffre(3) = "three" chiffre(4) = "four" chiffre(5) = "five" chiffre(6) = "six" chiffre(7) = "seven" chiffre(8) = "eight" chiffre(9) = "nine" chiffre(10) = "ten" chiffre(11) = "eleven" chiffre(12) = "twelve" chiffre(13) = "thirteen" chiffre(14) = "fourteen" chiffre(15) = "fifteen" chiffre(16) = "sixteen" chiffre(17) = "seventeen" chiffre(18) = "eighteen" chiffre(19) = "nineteen" Static dizaine(1 To 9) '*** array containing the names of the tens dizaine(1) = "ten" dizaine(2) = "twenty" dizaine(3) = "thirty" dizaine(4) = "forty" dizaine(5) = "fifty" dizaine(6) = "sixty" dizaine(7) = "seventy" dizaine(8) = "eighty" dizaine(9) = "ninety" ' '*** Handling the zero franc case ' If nb >= 1 Then result = "" Else result = "zero" GoTo fintraitementfrancs End If ' '*** Handling millions ' varnum = Int(nb / 1000000) If varnum > 0 Then GoSub centaine_dizaine result = varlet + " million" If varlet <> "one" Then result = result + "s" End If ' '*** Handling thousands ' varnum = Int(nb) Mod 1000000 varnum = Int(varnum / 1000) If varnum > 0 Then GoSub centaine_dizaine If varlet <> "one" Then result = result + " " + varlet result = result + " thousand" End If ' '*** Handling hundreds and tens ' varnum = Int(nb) Mod 1000 If varnum > 0 Then GoSub centaine_dizaine result = result + " " + varlet End If result = LTrim(result) varlet = Right$(result, 4) ' '*** Handling the final "s" for twenty and hundred and the "of" for million ' Select Case varlet Case "hundred", "ty" result = result + "s" Case "lion", "ions" result = result + " of" End Select fintraitementfrancs: '*** Branching label for the "zero franc" case ' '*** Indication of the term euro ' result = result + " euro" If nb >= 2 Then result = result + "s" ' '*** Handling cents ' varnum = Int((nb - Int(nb)) * 100 + 0.5) '*** Adding 0.5 '*** to compensate for rounding errors If varnum > 0 Then GoSub centaine_dizaine result = result + " and " + varlet + " cent" If varnum > 1 Then result = result + "s" End If ' '*** Converting 1st letter to uppercase ' result = UCase(Left(result, 1)) + Right(result, Len(result) - 1) ' '*** Return the result of the function and end of the function ' NBenLettres = result Exit Function centaine_dizaine: '*** Subprogram for conversion to letters ' '*** of hundreds and tens ' varlet = "" ' '*** Handling hundreds ' If varnum >= 100 Then varlet = chiffre(Int(varnum / 100)) varnum = varnum Mod 100 If varlet = "one" Then varlet = "hundred " Else varlet = varlet + " hundred " End If End If ' '*** Handling tens ' If varnum <= 19 Then '*** Case where the ten is <20 If varnum > 0 Then varlet = varlet + chiffre(varnum) Else '*** Other cases varnumD = Int(varnum / 10) '*** tens digit varnumU = varnum Mod 10 '*** units digit '''Select Case varnumD '*** generation of tens in letters varlet = varlet + dizaine(varnumD) '''Case Is <= 5 '''varlet = varlet + dizaine(varnumD) '''Case 6, 7 '''varlet = varlet + dizaine(6) '''Case 8, 9 '''varlet = varlet + dizaine(8) '''End Select ' '*** handling the separator of tens and units ' If varnumU = 1 And varnumD < 8 Then varlet = varlet + " and " Else If varnumU <> 0 Then varlet = varlet + "-" '''Or varnumD = 7 Or varnumD = 9 End If End If ' '*** generation of units ' '''If varnumD = 7 Or varnumD = 9 Then varnumU = varnumU + 10 If varnumU <> 0 Then varlet = varlet + chiffre(varnumU) End If ' '*** Removing leading spaces and return ' varlet = RTrim(varlet) Return End Function