DominoArea.org [Archive]

Code : Tout sélectionner

Public Function NombreEnLettre(Byval wNombre As String) As String
   
   'cette fonction transforme le nombre en chiffre en lettre
   
   'ex  251 = Deux Cent cinquante et un
   
   'La limite est de 999 999 999 999,999 999 999 99
   
   'Déclaration Variable
   Dim Entier As String
   Dim Decimal  As String
   
   On Error Goto ErreurHandle
   
   NombreEnLettre = ""
   
   If Trim(wNombre) = "" Then
      Exit Function
   End If
   
   wNombre = Replace(wNombre, ".", ",")
   If Not Isnumeric(wNombre) Then
   '   Msgbox "''wNombre''" + " n'est pas un nombre", 16 , " ATTENTION !"
      NombreEnLettre = ""
      Exit Function
   End If
   
   If Instr(wNombre, ",") = 0 Then 'c'est un Entier
      NombreEnLettre  = NombreEnLettreSuite(wNombre)
   Else 'c'est un Decimal
      Do While Right(wNombre, 1) = "0"
       'suppression des zéros à droite de la partie décimale
         If Right(wNombre, 1) = "0" Then
            wNombre = Left(wNombre, Len(wNombre) - 1)
         End If   
      Loop
      
      Entier = NombreEnLettreSuite(Left(wNombre, Instr(wNombre, ",") - 1))
      If Right(Entier, 2) = "un" Then
         Entier = Entier + "e"
      End If
      
      If Entier = "une" Then
         Entier = Entier + " unité "
      Elseif Entier <> "" Then
         Entier = Entier + " unités "
      End If
      
      Decimal = NombreEnLettreSuite(Mid(wNombre, Instr(wNombre, ",") + 1))
      NombreEnLettre = Entier + Decimal + " "
      
      Select Case Len(Mid(wNombre, Instr(wNombre, ",") + 1))
      Case 1
         NombreEnLettre = NombreEnLettre + "dixième"
      Case 2
         NombreEnLettre = NombreEnLettre + "centième"
      Case 3
         NombreEnLettre = NombreEnLettre + "millième"
      Case 4
         NombreEnLettre = NombreEnLettre + "dix-millième"
      Case 5
         NombreEnLettre = NombreEnLettre + "cent-millième"
      Case 6
         NombreEnLettre = NombreEnLettre + "millionième"
      Case 7
         NombreEnLettre = NombreEnLettre + "dix-millionième"
      Case 8
         NombreEnLettre = NombreEnLettre + "cent-millionième"
      Case 9
         NombreEnLettre = NombreEnLettre + "milliardième"
      Case 10
         NombreEnLettre = NombreEnLettre + "dix-milliardième"
      Case 11
         NombreEnLettre = NombreEnLettre + "cent-milliardième"
      End Select
      
      If Decimal <> "un" Then
         NombreEnLettre= NombreEnLettre + "s"
      End If
   End If
   
   Entier = ""
   Decimal = ""
   
   Exit Function
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Entier = ""
   Decimal = ""
   NombreEnLettre = ""
   Exit Function
End Function

Function NombreEnLettreSuite(Byval wNombreSuite As String) As String
   
   'Déclaration Varaible
   
   On Error Goto ErreurHandle
   
   If Trim(wNombreSuite) = "" Then
      NombreEnLettreSuite = ""
      Exit Function
   End If
   
   Do While Left(wNombreSuite, 1) = "0"
       'suppression des zéros à gauche
      If Left(wNombreSuite, 1) = "0" Then
         wNombreSuite = Mid(wNombreSuite, 2)
      End If   
   Loop
   
   Select Case Len(wNombreSuite)
   Case 0
      NombreEnLettreSuite = ""
   Case 1
      Select Case wNombreSuite
      Case "0"
         NombreEnLettreSuite = "zéro"
      Case "1"
         NombreEnLettreSuite = "un"
      Case "2"
         NombreEnLettreSuite = "deux"
      Case "3"
         NombreEnLettreSuite = "trois"
      Case "4"
         NombreEnLettreSuite = "quatre"
      Case "5"
         NombreEnLettreSuite = "cinq"
      Case "6"
         NombreEnLettreSuite = "six"
      Case "7"
         NombreEnLettreSuite = "sept"
      Case "8"
         NombreEnLettreSuite = "huit"
      Case "9"
         NombreEnLettreSuite = "neuf"
      End Select
   Case 2
      Select Case wNombreSuite
      Case "10"
         NombreEnLettreSuite = "dix"
      Case "11"
         NombreEnLettreSuite = "onze"
      Case "12"
         NombreEnLettreSuite = "douze"
      Case "13"
         NombreEnLettreSuite = "treize"
      Case "14"
         NombreEnLettreSuite = "quatorze"
      Case "15"
         NombreEnLettreSuite = "quinze"
      Case "16"
         NombreEnLettreSuite = "seize"
      Case "17" To "19"
         NombreEnLettreSuite = "dix " + NombreEnLettreSuite(Right(wNombreSuite, 1))
      Case "20" To "29"
         NombreEnLettreSuite = "vingt " + NombreEnLettreSuite(Right(wNombreSuite, 1))
      Case "30" To "39"
         NombreEnLettreSuite = "trente " + NombreEnLettreSuite(Right(wNombreSuite, 1))
      Case "40" To "49"
         NombreEnLettreSuite = "quarante " + NombreEnLettreSuite(Right(wNombreSuite, 1))
      Case "50" To "59"
         NombreEnLettreSuite = "cinquante " + NombreEnLettreSuite(Right(wNombreSuite, 1))
      Case "60" To "69"
         NombreEnLettreSuite = "soixante " + NombreEnLettreSuite(Right(wNombreSuite, 1))
      Case "70" To "79"
         wNombreSuite = Format(Val(wNombreSuite) - 60, "##")
         NombreEnLettreSuite = "soixante " + NombreEnLettreSuite(wNombreSuite)
         If Right(NombreEnLettreSuite, 4) = "onze" Then
            NombreEnLettreSuite = "soixante et onze"
         End If
      Case "80"
         NombreEnLettreSuite = "quatre-vingts"
      Case "81" To "99"
         wNombreSuite = Format(Val(wNombreSuite) - 80, "##")
         NombreEnLettreSuite = "quatre-vingt " + NombreEnLettreSuite(wNombreSuite)
      End Select
      If Right(NombreEnLettreSuite, 2) = "un" And wNombreSuite > "20" And wNombreSuite < 70 Then
         NombreEnLettreSuite = Left(NombreEnLettreSuite, Len(NombreEnLettreSuite) - 2) + "et un"
      End If
      
      If Right(NombreEnLettreSuite, 4) = "zéro" Then
         NombreEnLettreSuite = Left(NombreEnLettreSuite, Len(NombreEnLettreSuite) - 5)
      End If   
   Case 3
      Select Case Left(wNombreSuite, 1)
      Case "1"
         NombreEnLettreSuite = "cent " + NombreEnLettreSuite(Mid(wNombreSuite, 2))
         
      Case Else
         NombreEnLettreSuite = NombreEnLettreSuite(Left(wNombreSuite, 1)) + " cent " + NombreEnLettreSuite(Mid(wNombreSuite, 2))
         If Right(NombreEnLettreSuite, 6) = " cent " Then
            NombreEnLettreSuite = Left(NombreEnLettreSuite, Len(NombreEnLettreSuite) - 1) + "s"
         End If   
         
      End Select
   Case 4 To 6
      NombreEnLettreSuite = NombreEnLettreSuite(Left(wNombreSuite, Len(wNombreSuite) - 3)) + " mille " + NombreEnLettreSuite(Right(wNombreSuite, 3))
      If Left(NombreEnLettreSuite, 2) = "un" Then
         NombreEnLettreSuite = Mid(NombreEnLettreSuite, 4)
      End If   
      
   Case 7 To 9
      NombreEnLettreSuite = NombreEnLettreSuite(Left(wNombreSuite, Len(wNombreSuite) - 6)) + " millions " + NombreEnLettreSuite(Right(wNombreSuite, 6))
      If Left(NombreEnLettreSuite, 2) = "un" Then
         NombreEnLettreSuite = Left(NombreEnLettreSuite, 10) + Mid(NombreEnLettreSuite, 12)
      End If   
      
   Case 10 To 12
      NombreEnLettreSuite = NombreEnLettreSuite(Left(wNombreSuite, Len(wNombreSuite) - 9)) + " milliards " + NombreEnLettreSuite(Right(wNombreSuite, 9))
      If Left(NombreEnLettreSuite, 2) = "un" Then
         NombreEnLettreSuite = Left(NombreEnLettreSuite, 11) + Mid(NombreEnLettreSuite, 13)
      End If   
      
   Case Else
   End Select
   
   Exit Function
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
      
   NombreEnLettreSuite = ""
End Function

VastoMarine a écrit:En interne...

Code : Tout sélectionner

Function ChiffreToLettre(Chiffre As Double) As String
Dim ext$, b$, b1$, result$
Dim Entier, Deci, V, i , k
V = 0
Entier = ""
Deci = ""
For i = 1 To Len(Chiffre)
If (Mid$(Chiffre, i, 1) <> "," And Mid$(Chiffre, i, 1) <> ".") And V = 0 Then
Entier = Entier & Mid$(Chiffre, i, 1)
End If
If (Mid$(Chiffre, i, 1) <> "," And Mid$(Chiffre, i, 1) <> ".") And V = 1 Then
Deci = Deci & Mid$(Chiffre, i, 1)
End If
If (Mid$(Chiffre, i, 1) = "," Or Mid$(Chiffre, i, 1) = ".") Then
V = 1
End If
Next i

'Do Until Chiffre = ""
' partie entière
Dim ByReste As Integer
Dim ByCent As Integer
ByCent = Int(Chiffre / 100)
'ByReste = Chiffre - (ByCent * 100)


Do Until Entier = ""
Select Case Int((Len(Entier) - 1) / 3)
Case 0: ext$ = ""
Case 1: ext$ = "mille "
Case 2: ext$ = "million "
Case 3: ext$ = "milliard "
End Select
K = Len(Entier) Mod 3
If K = 0 Then K = 3
b$ = Left$(Entier, K)
For i = 1 To K
b1$ = Mid$(b$, i, 1)
If (K - i + 1) <> 2 Then
Select Case b1$
Case "0": If i <> K Then result$ = result$ + "zéro "
Case "1": result$ = result$
If i <> 1 Or Len(b$) <> 3 Then
result$ = result$ + "un "
End If
Case "2": result$ = result$ + "deux "
Case "3": result$ = result$ + "trois "
Case "4": result$ = result$ + "quatre "
Case "5": result$ = result$ + "cinq "
Case "6": result$ = result$ + "six "
Case "7": result$ = result$ + "sept "
Case "8": result$ = result$ + "huit "
Case "9": result$ = result$ + "neuf "
Case "10": result$ = result$ + "dix "
End Select
Else
Select Case b1$
Case "1": result$ = result$
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "onze "
i = i + 1
Case "2": result$ = result$ + "douze "
i = i + 1
Case "3": result$ = result$ + "treize "
i = i + 1
Case "4": result$ = result$ + "quatorze "
i = i + 1
Case "5": result$ = result$ + "quinze "
i = i + 1
Case "6": result$ = result$ + "seize "
i = i + 1
Case Else: result$ = result$ + "dix "
End Select
Case "2": result$ = result$ + "vingt "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select
Case "3": result$ = result$ + "trente "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select
Case "4": result$ = result$ + "quarante "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select
Case "5": result$ = result$ + "cinquante "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select
Case "6": result$ = result$ + "soixante "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select
Case "7": result$ = result$ + "septante "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select

Case "8": result$ = result$ + "quatre vingt "
Case "9": result$ = result$ + "nonante "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select

End Select
End If
If K = 3 And i = 1 Then
If ByReste = 0 Then
result$ = result$ + "cents "
Else
result$ = result$ + "cent "
End If
End If
Next i
result$ = result$ + ext$
Entier = Right$(Entier, Len(Entier) - K)
While Left$(Entier, 1) = "0"
Entier = Right$(Entier, Len(Entier) - 1)
Wend
Loop
If result$ Like "un mil*" Then result$ = Mid(result$, 4)



ChiffreToLettre = result$ + " € "

' partie décimale
result$ = ""
If Len(deci) = 1 Then deci = deci + "0"
Do Until Deci = ""
Select Case Int((Len(Deci) - 1) / 3)
Case 0: ext$ = ""
Case 1: ext$ = "mille "
Case 2: ext$ = "million "
Case 3: ext$ = "milliard "
End Select
K = Len(Deci) Mod 3
If K = 0 Then K = 3
b$ = Left$(Deci, K)
For i = 1 To K
b1$ = Mid$(b$, i, 1)
If (K - i + 1) <> 2 Then
Select Case b1$
Case "0": If i <> 2 Then result$ = result$ + "zéro "
Case "1": result$ = result$
If i <> 1 Or Len(b$) <> 3 Then
result$ = result$ + "un "
End If
Case "2": result$ = result$ + "deux "
Case "3": result$ = result$ + "trois "
Case "4": result$ = result$ + "quatre "
Case "5": result$ = result$ + "cinq "
Case "6": result$ = result$ + "six "
Case "7": result$ = result$ + "sept "
Case "8": result$ = result$ + "huit "
Case "9": result$ = result$ + "neuf "
Case "10": result$ = result$ + "dix "
End Select
Else
Select Case b1$
Case "1": result$ = result$
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "onze "
i = i + 1
Case "2": result$ = result$ + "douze "
i = i + 1
Case "3": result$ = result$ + "treize "
i = i + 1
Case "4": result$ = result$ + "quatorze "
i = i + 1
Case "5": result$ = result$ + "quinze "
i = i + 1
Case "6": result$ = result$ + "seize "
i = i + 1
Case Else: result$ = result$ + "dix "
End Select
Case "2": result$ = result$ + "vingt "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select
Case "3": result$ = result$ + "trente "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select
Case "4": result$ = result$ + "quarante "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select
Case "5": result$ = result$ + "cinquante "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select
Case "6": result$ = result$ + "soixante "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select
Case "7": result$ = result$ + "septante "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select

Case "8": result$ = result$ + "quatre vingt "
Case "9": result$ = result$ + "nonante "
Select Case (Mid$(b$, i + 1, 1))
Case "1": result$ = result$ + "et "
End Select

End Select
End If
If K = 3 And i = 1 Then result$ = result$ + "cent "
Next i
Suite:
result$ = result$ + ext$
Deci = Right$(Deci, Len(Deci) - K)
While Left$(Deci, 1) = "0"
Deci = Right$(Deci, Len(Deci) - 1)
Wend
Loop
If result$ Like "un mil*" Then result$ = Mid(result$, 4)
If result$ <> "zéro " And result$ <> "" And result$ <> "un " Then ChiffreToLettre = ChiffreToLettre & " et " & result$ + " cents "
If result$ = "un " Then ChiffreToLettre = ChiffreToLettre & " et " & result$ + " cent "+ " cents "
End Function