je veux pouvoir convertir un nombre en lettre
soit salaire: 200 en chiffre donne deux cent en lettre
Bonjour,
Voici une fonction VBA toute faite qui n’est pas de moi.
A mettre à ta sauce
Chiffres-en-Lettres.xlsm (27,9 Ko)
'***********
' 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 & " Cent"
Case 2
strDev = " Dollar"
If dblEnt >= 1000000 And Right(dblEnt, 6) = "000000" Then strDev = " de Dollar"
If byDec > 0 Then strCentimes = strCentimes & " Cent"
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 Cent"
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 = "cent"
Else
ConvNumCent = "cent " & strReste
End If
Case Else
If byReste = 0 Then
ConvNumCent = TabUnit(byCent) & " cents"
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
2 « J'aime »
bien reçu je vais faire le test voir et je vous donne la suite. merci
d’avance
MERCI BEAUCOUP. XA MARCHE TRÈS BIEN
je veux pouvoir faire sortir le mois en cours
Exemple: Janvier 2018
Veuillez me guider svp
Bonjour Doc,
J’ai pas compris ta demande
Bonjour les amies, une petite secours svp, suis débutant en Vba, j’ai testé le fichier que Mimimathy nous a donné mais je sais où aller sur le capture?
Merci!
Est-ce que tu peux mettre le code VBA dans tes messages stp?
Tous les détails de la demande, le code VBA et les formules doivent être dans le corps du message (pas cachés au fond du fichier Excel)
Comment ajouter d’autres dévises svp?
Tu peux aussi faire tout cela sans code VBA, vas voir sur le site suivant : Convertir très simplement des chiffres en lettres - Trucs et astuces - Articles - veriti
1 « J'aime »
Bonjour
Vous avez aussi le programme suivant à integrer dans excel
Voici le lien
https://drive.google.com/file/d/1AyU87mkGiRUQ-lCThDY9cbc1veIlyxG4/view?usp=sharing
Amicalement
orguyrine
Je vous remercie infiniment
1 « J'aime »