Formule ConvNumberLetter et unités

Bonjour

j'utilise la formule =ConvNumberLetter(B34)&" euros" téléchargée sur le net pour transformer des nombres en lettres mais lorsque j"entre 123 euros j’obtiens centimes vingt-trois euros mais pour 410 euros j’obtiens bien quatre cent dix euros.

Les formules, format de cellule ainsi que les unités sont identiques.

Voici la macro :

Sub test()

MsgBox ConvNumberLetter(-535896523.02, 2, 2, 0, 0)

End Sub

'***********
' Devise=0 aucune
' =1 Euro Û
' =2 Dollar $
' =3 Livre £
' Langue=0 Franais
' =1 Belgique
' =2 Suisse
' Casse =0 Minuscule
' =1 Majuscule en dŽbut de phrase
' =2 Majuscule
' =3 Majuscule en dŽbut de chaque mot
' ZeroCent=0 Ne mentionne pas les cents s'ils sont Žgal ˆ 0
' =1 Mentionne toujours les cents
'***********
' Conversion limitŽe ˆ 999 999 999 999 999 ou 9 999 999 999 999,99
' si le nombre contient plus de 2 dŽcimales, il est arrondit ˆ 2 dŽcimales

Public Function ConvNumberLetter(Nombre As Double, Optional Devise As Byte = 0, _
Optional Langue As Byte = 0, _
Optional Casse As Byte = 0, _
Optional ZeroCent As Byte = 0) As String
Dim dblEnt As Variant, byDec As Byte
Dim bNegatif As Boolean, T As String, C As String
Dim strDev As String, strCentimes As String

If Nombre < 0 Then
bNegatif = True
Nombre = Abs(Nombre)
End If
dblEnt = Int(Nombre)
byDec = CInt((Nombre - dblEnt) * 100)
If byDec = 0 Then
If dblEnt > 999999999999999# Then
ConvNumberLetter = "#TropGrand"
Exit Function
End If
Else
If dblEnt > 9999999999999.99 Then
ConvNumberLetter = "#TropGrand"
Exit Function
End If
End If
Select Case Devise
Case 0
If byDec > 0 Then strDev = " virgule "
Case 1
strDev = " Euro"
If dblEnt >= 1000000 And Right(dblEnt, 6) = "000000" Then strDev = " d'Euro"
If byDec > 0 Then strCentimes = strCentimes & " Centimes"
Case 2
strDev = " Dollar"
If dblEnt >= 1000000 And Right(dblEnt, 6) = "000000" Then strDev = " de Dollar"
If byDec > 0 Then strCentimes = strCentimes & " Centimes"
Case 3
strDev = " Livre"
If dblEnt >= 1000000 And Right(dblEnt, 6) = "000000" Then strDev = " de Livre"
If byDec <= 1 Then strCentimes = strCentimes & " Penny"
If byDec > 1 Then strCentimes = strCentimes & " Pennie"
End Select
If dblEnt > 1 And Devise <> 0 Then strDev = strDev & "s"
strDev = strDev & " "
If dblEnt = 0 Then
ConvNumberLetter = "zŽro " & strDev
Else
ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev
End If
If byDec = 0 Then
If Devise <> 0 Then
If ZeroCent = 1 Then ConvNumberLetter = ConvNumberLetter & "zŽro Centime"
End If
Else
If Devise = 0 Then
ConvNumberLetter = ConvNumberLetter & _
ConvNumDizaine(byDec, Langue, True) & strCentimes
Else
'ajoute "ET" entre les dollars et les cents.
T = ConvNumDizaine(byDec, Langue, False)
C = IIf(T <> " un", strCentimes & "s", strCentimes)
ConvNumberLetter = ConvNumberLetter & " et " & _
T & C
' ConvNumberLetter = ConvNumberLetter & " et " & _
ConvNumDizaine(byDec, Langue, False) & strCentimes
End If
End If
ConvNumberLetter = Replace(ConvNumberLetter, " ", " ")
If Left(ConvNumberLetter, 1) = " " Then ConvNumberLetter = _
Right(ConvNumberLetter, Len(ConvNumberLetter) - 1)
If Right(ConvNumberLetter, 1) = " " Then ConvNumberLetter = _
Left(ConvNumberLetter, Len(ConvNumberLetter) - 1)
Select Case Casse
Case 0
ConvNumberLetter = LCase(ConvNumberLetter)
Case 1
ConvNumberLetter = UCase(Left(ConvNumberLetter, 1)) & _
LCase(Right(ConvNumberLetter, Len(ConvNumberLetter) - 1))
Case 2
ConvNumberLetter = UCase(ConvNumberLetter)
Case 3
ConvNumberLetter = Application.WorksheetFunction.Proper(ConvNumberLetter)
If Devise = 3 Then _
ConvNumberLetter = Replace(ConvNumberLetter, "Dinars", "Dinars", , , vbTextCompare)
End Select
End Function

Private Function ConvNumEnt(Nombre As Double, Langue As Byte)
Dim iTmp As Variant, dblReste As Double
Dim strTmp As String
Dim iCent As Integer, iMille As Integer, iMillion As Integer
Dim iMilliard As Integer, iBillion As Integer

iTmp = Nombre - (Int(Nombre / 1000) * 1000)
iCent = CInt(iTmp)
ConvNumEnt = Nz(ConvNumCent(iCent, Langue))
dblReste = Int(Nombre / 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iMille = CInt(iTmp)
strTmp = ConvNumCent(iMille, Langue)
Select Case iTmp
Case 0
Case 1
strTmp = " mille "
Case Else
strTmp = strTmp & " mille "
End Select
If iMille = 0 And iCent > 0 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
dblReste = Int(dblReste / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iMillion = CInt(iTmp)
strTmp = ConvNumCent(iMillion, Langue)
Select Case iTmp
Case 0
Case 1
strTmp = strTmp & " million "
Case Else
strTmp = strTmp & " millions "
End Select
If iMille = 1 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
dblReste = Int(dblReste / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iMilliard = CInt(iTmp)
strTmp = ConvNumCent(iMilliard, Langue)
Select Case iTmp
Case 0
Case 1
strTmp = strTmp & " milliard "
Case Else
strTmp = strTmp & " milliards "
End Select
If iMillion = 1 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
dblReste = Int(dblReste / 1000)
iTmp = dblReste - (Int(dblReste / 1000) * 1000)
If iTmp = 0 And dblReste = 0 Then Exit Function
iBillion = CInt(iTmp)
strTmp = ConvNumCent(iBillion, Langue)
Select Case iTmp
Case 0
Case 1
strTmp = strTmp & " billion "
Case Else
strTmp = strTmp & " billions "
End Select
If iMilliard = 1 Then ConvNumEnt = "et " & ConvNumEnt
ConvNumEnt = Nz(strTmp) & ConvNumEnt
End Function

Private Function ConvNumDizaine(Nombre As Byte, Langue As Byte, bDec As Boolean) As String
Dim TabUnit As Variant, TabDiz As Variant
Dim byUnit As Byte, byDiz As Byte
Dim strLiaison As String

If bDec Then
TabDiz = Array("zŽro", "", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante", "quatre-vingt", "quatre-vingt")
Else
TabDiz = Array("", "", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante", "quatre-vingt", "quatre-vingt")
End If
If Nombre = 0 Then
TabUnit = Array("zŽro")
Else
TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", _
"seize", "dix-sept", "dix-huit", "dix-neuf")
End If
If Langue = 1 Then
TabDiz(7) = "septante"
TabDiz(9) = "nonante"
ElseIf Langue = 2 Then
TabDiz(7) = "septante"
TabDiz(8) = "huitante"
TabDiz(9) = "nonante"
End If
byDiz = Int(Nombre / 10)
byUnit = Nombre - (byDiz * 10)
strLiaison = "-"
If byUnit = 1 Then strLiaison = " et "
Select Case byDiz
Case 0
strLiaison = " "
Case 1
byUnit = byUnit + 10
strLiaison = ""
Case 7
If Langue = 0 Then byUnit = byUnit + 10
Case 8
If Langue <> 2 Then strLiaison = "-"
Case 9
If Langue = 0 Then
byUnit = byUnit + 10
strLiaison = "-"
End If
End Select
ConvNumDizaine = TabDiz(byDiz)
If byDiz = 8 And Langue <> 2 And byUnit = 0 Then ConvNumDizaine = ConvNumDizaine & "s"
If TabUnit(byUnit) <> "" Then
ConvNumDizaine = ConvNumDizaine & strLiaison & TabUnit(byUnit)
Else
ConvNumDizaine = ConvNumDizaine
End If
End Function

Private Function ConvNumCent(Nombre As Integer, Langue As Byte) As String
Dim TabUnit As Variant
Dim byCent As Byte, byReste As Byte
Dim strReste As String

TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix")
byCent = Int(Nombre / 100)
byReste = Nombre - (byCent * 100)
strReste = ConvNumDizaine(byReste, Langue, False)
Select Case byCent
Case 0
ConvNumCent = strReste
Case 1
If byReste = 0 Then
ConvNumCent = "centime"
Else
ConvNumCent = "centime " & strReste
End If
Case Else
If byReste = 0 Then
ConvNumCent = TabUnit(byCent) & " centimes"
Else
ConvNumCent = TabUnit(byCent) & " cent " & strReste
End If
End Select
End Function

Private Function Nz(strNb As String) As String
If strNb <> " zŽro" Then Nz = strNb
End Function

Merci pour votre aide ;)

Yves

Bonjour le forum, bidaya,

Pourtant ça fonctionne, voir dans le fichier joint.

Cordialement.

Bonjour,

Au cas ou d'autres chercheraient sans macro.

Bonsoir merci pour ces réponses :

@mdo100 : effectivement la macro fonctionne mais pour des centimes égales à 0 (0 centime) il écrit cent au lieu de centime....le mystère des macros...

@Xmenpl : très bon tuyau si la macro ne fonctionne pas de façon définitive, je sais que faire.

Bien cordialement.

Yves

Bonsoir bidaya,

Voilà c'est corrigé

Belle soirée.

Ah oui !

Merci.

Bonne journée ;)