Bonsoir,
il y a quelques années j'ai écrit une fonction, elle me parait bien compliquée, mais elle fonctionne.
La voici:
Option Explicit
Dim LongChaine As Integer
Dim PosVirgule As Integer
Dim Francs As Variant
Dim Dix As Variant
Dim Mille As Variant
Dim Cent As Variant
Dim DixMille As Variant
Dim Centimes As Variant
Function Calcul(Nombre)
Dim Unités As Variant
Dim Milliers As Variant
Dim Millions As Variant
Dim LesUnités As Variant
Dim LesMilliers As Variant
Dim LesMillions As Variant
Dim LongFrancs As Variant
Dim LongMilliers As Integer
Dim LongMillions As Integer
LongChaine = Len(Nombre)
PosVirgule = InStr(Nombre, ",")
Francs = CalculFrancs(Nombre)
Centimes = CalculCentimes(Nombre)
LongFrancs = Len(Francs)
If LongFrancs <= 3 Then
Unités = Francs
Else
Unités = Mid(Francs, LongFrancs - 2, 3)
End If
LesUnités = TroisChiffres(Unités) & " Francs" & Centimes
If LongFrancs > 3 Then
LongMilliers = LongFrancs - 3
If LongMilliers > 3 Then LongMilliers = 3
Milliers = Mid(Francs, LongFrancs - LongMilliers - 2, LongMilliers)
LesMilliers = TroisChiffres(Milliers) & " Mille"
If LesMilliers = " Mille" Then LesMilliers = ""
If LesMilliers = " et Un Mille" Then LesMilliers = " Mille"
End If
If LongFrancs > 6 Then
LongMillions = LongFrancs - 6
If LongMillions > 3 Then LongMillions = 3
Millions = Mid(Francs, LongFrancs - LongMillions - 5, LongMillions)
LesMillions = TroisChiffres(Millions) & " Millions"
If LesMillions = " et Un Millions" Then LesMillions = " Un Million "
End If
If Unités = "000" And Milliers = "000" Then LesUnités = " de Francs" & Centimes
Calcul = LesMillions & LesMilliers & LesUnités
End Function
Function TroisChiffres(MorceauDeFrancs)
Dim LongMorceau As Integer
Dim Unité As Variant
Dim Un As Variant
Dim Dizaine As Variant
Dim DixUn As Variant
Dim Centaine As Variant
Cent = ""
Dix = ""
Un = ""
LongMorceau = Len(MorceauDeFrancs)
If LongMorceau >= 1 Then 'Unité
Unité = Mid(MorceauDeFrancs, (LongMorceau), 1)
If Unité = 0 Then
Un = ""
ElseIf Unité = 1 Then
Un = " et " & UnàDixNeuf(Unité)
Else
Un = " " & UnàDixNeuf(Unité)
End If
End If
If LongMorceau >= 2 Then 'Dizaine
Dizaine = Mid(MorceauDeFrancs, (LongMorceau - 1), 1)
If Dizaine = 0 Then
Dix = ""
Un = " " & UnàDixNeuf(Unité)
Else
Dix = " " & DixàQuatreVingtDix(Dizaine)
End If
Select Case Dix
Case " Dix"
Dizaine = Mid(MorceauDeFrancs, (LongMorceau - 1), 2)
Dix = " " & UnàDixNeuf(Dizaine)
Un = ""
Case " Soixante-Dix"
Dizaine = Mid(MorceauDeFrancs, (LongMorceau - 1), 2)
DixUn = UnàDixNeuf(Dizaine)
If DixUn = "Onze" Then
Dix = " Soixante et Onze"
Else
Dix = " Soixante-" & DixUn
End If
Un = ""
Case " Quatre-Vingt"
If Unité = 0 Then Dix = " Quatre-Vingts"
If Unité = 1 Then Un = " " & UnàDixNeuf(Unité)
Case " Quatre-Vingt-Dix"
Dizaine = Mid(MorceauDeFrancs, (LongMorceau - 1), 2)
DixUn = UnàDixNeuf(Dizaine)
Dix = " Quatre-Vingt-" & DixUn
Un = ""
End Select
End If
If LongMorceau >= 3 Then 'Centaine
Centaine = Mid(MorceauDeFrancs, (LongMorceau - 2), 1)
If Centaine = 0 Then
Cent = ""
Else
Cent = " " & UnàDixNeuf(Centaine) & " Cent"
If Cent = " Un Cent" Then Cent = " Cent"
End If
If Dizaine = 0 And Unité = 0 And Centaine > 1 Then
Cent = Cent & "s"
End If
End If
TroisChiffres = Cent & Dix & Un
End Function
Function CalculFrancs(Nombre As Variant)
If PosVirgule = 0 Then
CalculFrancs = Nombre
Else
CalculFrancs = Left(Nombre, PosVirgule - 1)
End If
End Function
Function CalculCentimes(Nombre As Variant)
If PosVirgule <> 0 Then
Centimes = Right(Nombre, LongChaine - PosVirgule)
If Len(Centimes) = 1 Then
Centimes = Centimes & "0"
End If
CalculCentimes = " et " & Centimes & " Cts"
End If
End Function
Function UnàDixNeuf(Rank)
Dim Chiffre As Variant
Select Case Rank
Case 0
Chiffre = ""
Case 1
Chiffre = "Un"
Case 2
Chiffre = "Deux"
Case 3
Chiffre = "Trois"
Case 4
Chiffre = "Quatre"
Case 5
Chiffre = "Cinq"
Case 6
Chiffre = "Six"
Case 7
Chiffre = "Sept"
Case 8
Chiffre = "Huit"
Case 9
Chiffre = "Neuf"
Case 10, 70, 90
Chiffre = "Dix"
Case 11, 71, 91
Chiffre = "Onze"
Case 12, 72, 92
Chiffre = "Douze"
Case 13, 73, 93
Chiffre = "Treize"
Case 14, 74, 94
Chiffre = "Quatorze"
Case 15, 75, 95
Chiffre = "Quinze"
Case 16, 76, 96
Chiffre = "Seize"
Case 17, 77, 97
Chiffre = "Dix-Sept"
Case 18, 78, 98
Chiffre = "Dix-Huit"
Case 19, 79, 99
Chiffre = "Dix-Neuf"
End Select
UnàDixNeuf = Chiffre
End Function
Function DixàQuatreVingtDix(Rank)
Dim Chiffre As Variant
Select Case Rank
Case 0
Chiffre = ""
Case 1
Chiffre = "Dix"
Case 2
Chiffre = "Vingt"
Case 3
Chiffre = "Trente"
Case 4
Chiffre = "Quarante"
Case 5
Chiffre = "Cinquante"
Case 6
Chiffre = "Soixante"
Case 7
Chiffre = "Soixante-Dix"
Case 8
Chiffre = "Quatre-Vingt"
Case 9
Chiffre = "Quatre-Vingt-Dix"
End Select
DixàQuatreVingtDix = Chiffre
End Function
il faut la mettre avec l'editeur de visual basic dans un module que j'ai appelé "fonction"
et je l'appelle dans un tableau par =calcul(A1) par exemple.
