TRADUCTION D'UN MONTANT NUMÉRIQUE EN EXPRESSION LITTÉRALE

Public Function m_ÉcritMontant(Montant As Currency, Optional Monnaie As String, Optional Centime As String) As String
'---------------------------
'skrol29@freesurf.fr
'Version 1.00, le 01/02/1999
'Version 1.02, le 12/05/2002
'---------------------------

  Dim t1(20) As String
  Dim t2(9) As String
  Dim t3(6) As String
  
  Dim i     As Integer
  Dim i_max As Integer
  Dim i_min As Integer
  Dim m     As String    'Montant numérique sous forme de chaîne formatée "000"
  Dim r     As Integer   'Reste de la longueur à cobler pour avoir un format "000"
  Dim p     As String    'Partie au format "000"
  Dim p1    As Integer   ' partie untié    de P
  Dim p2    As Integer   ' partie dizaine  de P
  Dim p3    As Integer   ' partie centaine de P
  Dim w     As String    'Montant en lettre de P
  Dim x     As String    'Montant en lettre final
  
  t1(0) = ""
  t1(1) = "un"
  t1(2) = "deux"
  t1(3) = "trois"
  t1(4) = "quatre"
  t1(5) = "cinq"
  t1(6) = "six"
  t1(7) = "sept"
  t1(8) = "huit"
  t1(9) = "neuf"
  t1(10) = "dix"
  t1(11) = "onze"
  t1(12) = "douze"
  t1(13) = "treize"
  t1(14) = "quatorze"
  t1(15) = "quinze"
  t1(16) = "seize"
  t1(17) = "dix-sept"
  t1(18) = "dix-huit"
  t1(19) = "dix-neuf"
  t1(20) = "vingt"
  
  t2(0) = ""
  t2(1) = ""
  t2(2) = "vingt"
  t2(3) = "trente"
  t2(4) = "quarante"
  t2(5) = "cinquante"
  t2(6) = "soixante"
  t2(7) = "soixante"
  t2(8) = "quatre-vingt"
  t2(9) = "quatre-vingt"
  
  If Monnaie = "" Then
    Centime = ""
  Else
    If Montant >= 2 Then
      Monnaie = Monnaie & "s"
    End If
    If Centime <> "" Then
      If ((Montant - Fix(Montant)) * 100) >= 2 Then
        Centime = Centime & "s"
      End If
      If ((Montant - Fix(Montant)) * 100) > 0 Then
        Monnaie = Monnaie & " et"
      End If
    End If
  End If
  
  t3(0) = Centime
  t3(1) = Monnaie
  t3(2) = "mille"
  t3(3) = "million"
  t3(4) = "milliard"
  t3(5) = "billiard"
  t3(6) = "triard"
  
  'Mise en forme en chaîne
  m = Format$(Montant, "000.00")
  r = Len(m) Mod 3
  If r > 0 Then
    m = Left$("000", 3 - r) & m
  End If
  i_max = (Len(m) / 3) - 1
  i_min = IIf(Centime = "", 1, 0)
  
  x = ""
  For i = i_min To i_max
  
    p = Mid$(m, Len(m) - (3 * i) - 2, 3)
    p1 = Val(Mid$(p, 3, 1))
    p2 = Val(Mid$(p, 2, 1))
    p3 = Val(Mid$(p, 1, 1))

    'centaines
    Select Case p3
    Case 0
      w = ""
    Case 1
      w = "cent"
    Case Else
      w = t1(p3) & IIf((p1 = 0) And (p2 = 0), " cents", " cent")
    End Select

    'dizaines
    Select Case p2
    Case 0, 1
      'de 0 à 19
      w = w & " " & t1(p1 + 10 * p2)
    Case 7, 9
      'on passe aux valeur qui dépasssent 10
      w = w & " " & t2(p2) & IIf((p1 = 1) And (p2 < 8), " et ", "-") & t1(p1 + 10)
    Case Else
      If (i <= 1) And (p2 = 8) And (p1 = 0) Then
        'Cas ou le montant se termine par "Quatre-vingts" tout rond
        w = w & " " & t2(8) & "s"
      Else
        w = w & " " & t2(p2) & IIf((p1 = 1) And (p2 < 8), " et ", IIf(p1 = 0, "", "-")) & t1(p1)
      End If
    End Select

    w = Trim$(w)

    'On affiche "zéro" si la somme fait "zéro euro"
    If (i > 0) And (Montant < 1) Then
      w = "zéro"
    End If


    If (w <> "") Or ((i = 1) And (i_max > 1)) Then
      If (i = 2) And (p = "001") Then
        'On évite le "un" s'il s'agit d'1 millier d'euro (exemple  : "mille deux cents", et non pas "un mille deux cent")
        x = t3(i) & " " & x
      Else
        'dans le cas classique, on colle la somme
        x = w & " " & t3(i) & " " & x
      End If
    End If

    x = Trim$(x)
  
  Next i
  
  m_ÉcritMontant = UCase$(Left$(x, 1)) & Mid$(x, 2)

End Function