[VB6] Conversion chiffres-lettres

Public Function sommelettre(ByVal argument As Currency) As String
       Dim entier As Double
       Dim cts As Double

       Dim resultat1 As String
       Dim resultat2 As String
       
       entier = Int(argument)            ' Valeur entière
       cts = (argument - entier) * 100   ' Valeur Centimes
       
       resultat1 = somlet2(entier)
       resultat2 = somlet2(cts)
       
       If Trim(resultat1) <> "" Then
          resultat1 = resultat1 & " Dinars "
       End If
       If Trim(resultat2) <> "" Then
          resultat2 = resultat2 & " Cts"
       End If
       sommelettre = resultat1 & " et " & resultat2
       
End Function
'*************************************************************
'     Fonction de conversion chiffres en lettres
'*************************************************************
Public Function somlet2(ByVal argument As Double) As String
       
       Dim lettres As Variant
       Dim unites As Variant
       Dim dizaines As Variant
       Dim centaines As Variant
       
       Dim unite As Integer
       Dim dix As Integer
       Dim cent As Integer
       
       Dim groupes As Variant
       Dim chaine As String
       Dim ng, nc As Integer
       Dim i, j, k As Integer
       Dim xx As String
       
       chaine = Trim(Str(argument))
       nc = Len(chaine)                  ' Nbre de chiffres
       
       
       lettres = Array("", "mille", "million", "milliard", "billion")
       unites = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", "dix huit", "dix neuf")
       dizaines = Array("", "dix", "vingt", "trente", "quarante", "cinquante", "soixante", "soixante dix", "quatre vingt", "quatre vingt dix")
       centaines = Array("", "cent", "deux cents", "trois cents", "quatre cents", "cinq cents", "six cents", "sept cents", "huit cents", "neuf cents")
       
       If argument = 0 Then
          somlet2 = ""
          Else
          If nc Mod 3 > 0 Then
             ng = Int(nc / 3) + 1           ' Nbre de groupes
             Else
             ng = nc / 3
          End If
          ReDim groupes(ng - 1)
          chaine = String(ng * 3 - nc, " ") & chaine
          nc = Len(chaine)
          j = 0
          For i = nc To 1 Step -3
              xx = Mid(chaine, i - 2, i)
              groupes(j) = xx
              j = j + 1
          Next
          chaine = ""
          For j = 0 To UBound(groupes)
              unite = Val(Mid(groupes(j), 3, 1))
              dix = Val(Mid(groupes(j), 2, 1))
              If dix = 1 Or dix = 7 Or dix = 9 Then
                 dix = dix - 1
                 unite = unite + 10
              End If
              cent = Val(Mid(groupes(j), 1, 1))
              chaine = centaines(cent) & " " & dizaines(dix) & " " & unites(unite) & " " & lettres(j) & " " & chaine
          Next
          somlet2 = chaine
       End If
End Function

Function NBenLettres(nb)
'
Dim varnum, varnumD, varnumU, varlet  ', résultat
'
'varnum : pour stocker les parties du nombre que l'on va découper
'varlet : pour stocker la conversion en lettres d'une partie du nombre
'varnumD : pour stocker la partie dizaine d'un nombre à 2 chiffres
'varnumU : pour stocker la partie unité d'un nombre à 2 chiffres
'résultat : pour stocker les résultats intermédiaires des différentes étapes
'
Static chiffre(1 To 19) '*** tableau contenant le nom des 16 premiers
nombres en lettres
chiffre(1) = "un"
chiffre(2) = "deux"
chiffre(3) = "trois"
chiffre(4) = "quatre"
chiffre(5) = "cinq"
chiffre(6) = "six"
chiffre(7) = "sept"
chiffre(8) = "huit"
chiffre(9) = "neuf"
chiffre(10) = "dix"
chiffre(11) = "onze"
chiffre(12) = "douze"
chiffre(13) = "treize"
chiffre(14) = "quatorze"
chiffre(15) = "quinze"
chiffre(16) = "seize"
chiffre(17) = "dix-sept"
chiffre(18) = "dix-huit"
chiffre(19) = "dix-neuf"
Static dizaine(1 To 9) '*** tableau contenant les noms des dizaines
dizaine(1) = "dix"
dizaine(2) = "vingt"
dizaine(3) = "trente"
dizaine(4) = "quarante"
dizaine(5) = "cinquante"
dizaine(6) = "soixante"
dizaine(7) = "soixante-dix"
dizaine(8) = "quatre-vingt"
dizaine(9) = "quatre-vingt-dix"
'
'*** Traitement du cas zéro franc
'
If nb >= 1 Then
  résultat = ""
 Else
  résultat = "zéro"
  GoTo fintraitementfrancs
End If
'
'*** Traitement des millions
'
varnum = Int(nb / 1000000)
If varnum > 0 Then
 GoSub centaine_dizaine
 résultat = varlet + " million"
 If varlet <> "un" Then résultat = résultat + "s"
End If
'
'*** Traitement des milliers
'
varnum = Int(nb) Mod 1000000
varnum = Int(varnum / 1000)
If varnum > 0 Then
 GoSub centaine_dizaine
 If varlet <> "un" Then résultat = résultat + " " + varlet
 résultat = résultat + " mille"
End If
'
'*** Traitement des centaines et dizaines
'
varnum = Int(nb) Mod 1000
If varnum > 0 Then
 GoSub centaine_dizaine
 résultat = résultat + " " + varlet
End If
résultat = LTrim(résultat)
varlet = Right$(résultat, 4)
'
'*** Traitement du "s" final pour vingt et cent et du "de" pour million
'
Select Case varlet
 Case "cent", "ingt"
  résultat = résultat + "s"
 Case "lion", "ions"
  résultat = résultat + " de"
End Select

fintraitementfrancs: '*** Etiquette de branchement pour le cas "zéro franc"
'
'*** Indication du terme franc
'
résultat = résultat + " euro"
If nb >= 2 Then résultat = résultat + "s"
'
'*** Traitement des centimes
'
varnum = Int((nb - Int(nb)) * 100 + 0.5) '*** On additionne 0,5
'*** afin de compenser les erreurs de calcul dues aux arrondis
If varnum > 0 Then
 GoSub centaine_dizaine
 résultat = résultat + " et " + varlet + " centime"
 If varnum > 1 Then résultat = résultat + "s"
End If
'
'*** Conversion 1ère lettre en majuscule
'
résultat = UCase(Left(résultat, 1)) + Right(résultat, Len(résultat) - 1)
'
'*** renvoie du résultat de la fonction et fin de la fonction
'
NBenLettres = résultat
Exit Function

centaine_dizaine: '*** Sous-programme de conversion en lettres
'
'*** des centaines et dizaines
'
varlet = ""
'
'*** Traitement des centaines
'
If varnum >= 100 Then
 varlet = chiffre(Int(varnum / 100))
 varnum = varnum Mod 100
 If varlet = "un" Then
   varlet = "cent "
  Else
   varlet = varlet + " cent "
 End If
End If
'
'*** Traitement des dizaines
'
If varnum <= 19 Then '*** Cas où la dizaine est <20
  If varnum > 0 Then varlet = varlet + chiffre(varnum)
 Else '*** Autres cas
  varnumD = Int(varnum / 10) '*** chiffre des dizaines
  varnumU = varnum Mod 10 '*** chiffre des unités
'''Select Case varnumD '*** génération des dizaines en lettres
  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
'
'*** traitement du séparateur des dizaines et unités
'
  If varnumU = 1 And varnumD < 8 Then
    varlet = varlet + " et "
   Else
    If varnumU <> 0 Then
     varlet = varlet + "-" '''Or varnumD = 7 Or varnumD = 9
    End If
  End If
'
'*** génération des unités
'
'''If varnumD = 7 Or varnumD = 9 Then varnumU = varnumU + 10
  If varnumU <> 0 Then varlet = varlet + chiffre(varnumU)
End If
'
'*** Suppression des espaces à gauche et retour
'
varlet = RTrim(varlet)
Return
End Function