Conversion du somme en lettre avec les centimes en chiffre!!!

[Didoucha]

Bonjour a tous,

Je souhaiterai pouvoir convertir et inscrire sur une facture un nombre en chiffre, a l'exception des centimes que je souhaite laisser en chiffre.
Ex : 1 250,10 euro = mille deux cent cinquante euro 10 cents.

J'ai trouve ce code, malheureusement toutes mes tentatives ont pour le moment echouees . Pouvez vous me donner un coup de main .

Je vous joint le code ci dessous.

Merci a tous d'avance

Public Function ConvertNbLettres(Nb, Devise As String) As String
'Macro realisee par Convertir un nombre en toutes lettres (français)
Dim varnum, varnumD, varnumU, resultat, varlet

Static Chiffre(1 To 19)
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 8)
dizaine(1) = "dix"
dizaine(2) = "vingt"
dizaine(3) = "trente"
dizaine(4) = "quarante"
dizaine(5) = "cinquante"
dizaine(6) = "soixante"
dizaine(8) = "quatre-vingt"

'traitement du cas 0
If Nb >= 1 Then
resultat = ""
Else
resultat = "ze'ro"
GoTo fintraitementfrancs
End If

'traitement des millions
varnum = Int(Nb / 1000000)
If varnum > 0 Then
GoSub centaine_dizaine
resultat = varlet + " million"
If varlet <> "un" Then: resultat = resultat + "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: resultat = resultat + " " + varlet
resultat = resultat + " mille"
End If

'traitement des centaines et dizaines
varnum = Int(Nb) Mod 1000
If varnum > 0 Then
GoSub centaine_dizaine
resultat = resultat + " " + varlet
End If
resultat = LTrim(resultat)
varlet = Right$(resultat, 4)

'traitement du "s" final pour vingt et cent et du "de" pour million
Select Case varlet
Case "cent", "ingt"
resultat = resultat + "s"
Case "lion", "ions"
resultat = resultat + " de"
End Select

fintraitementfrancs:
resultat = resultat + " " + Devise
If Nb > 2 Then: resultat = resultat + "s"

'traitement des centimes
varnum = Int((Nb - Int(Nb)) * 100 + 0.5)
If varnum > 0 Then
GoSub centaine_dizaine
resultat = resultat + " et " + varlet + " centime"
If varnum > 1 Then: resultat = resultat + "s"
End If

'conversion 1e`re lettre en majuscule
resultat = UCase(Left(resultat, 1)) + Right(resultat, Len(resultat) - 1)

'renvoi du resultat de la fonction et fin de la fonction
ConvertNbLettres = resultat
Exit Function

'sous programme
centaine_dizaine:
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
If varnum > 0 Then: varlet = varlet + Chiffre(varnum)
Else
varnumD = Int(varnum / 10)
varnumU = varnum Mod 10
Select Case varnumD
Case Is <= 5
varlet = varlet + dizaine(varnumD)
Case 6, 7
varlet = varlet + dizaine(6)
Case 8, 9
varlet = varlet + dizaine(8)
End Select
If varnumU = 1 And varnumD < 8 Then
varlet = varlet + " et "
Else
If varnumU <> 0 Or varnumD = 7 Or varnumD = 9 Then: varlet = varlet + " "
End If
If varnumD = 7 Or varnumD = 9 Then: varnumU = varnumU + 10
If varnumU <> 0 Then: varlet = varlet + Chiffre(varnumU)
End If
varlet = RTrim(varlet)
Return

End Function

 

[Modeste]

Re : Conversion du somme en lettre avec les centimes en chiffre!!!

Bonjour Didoucha,

Sauf erreur de ma part (je n'ai fait que 2-3 petits tests), il suffit de modifier comme suit:

Ligne 83: mettre en commentaire --> 'GoSub centaine_dizaine
Ligne 84: resultat = resultat + " et " + CStr(varnum) + " centime"

Il y a un arrondi à la deuxième décimale.

A tester donc,

Modeste

 

[Didoucha]

Re : Conversion du somme en lettre avec les centimes en chiffre!!!

Merci beaucoup Modeste ca fonctionne tip top