Convertir chiffre en lettre sous access

Fermé
tah - 5 juin 2012 à 16:06
eljojo_e Messages postés 1155 Date d'inscription lundi 10 mai 2010 Statut Membre Dernière intervention 14 octobre 2022 - 7 juin 2012 à 12:46
Bonjour,

Quel est le code pour convertir un chiffre ne lettre?


A voir également:

1 réponse

eljojo_e Messages postés 1155 Date d'inscription lundi 10 mai 2010 Statut Membre Dernière intervention 14 octobre 2022 153
7 juin 2012 à 12:46
Bonjour,

il faut mettre ce code dans un module, après tu tape dans un cellule :

=NombreTexte(Chiffre ou cellule;"€") ' "€" pour euro, tu peux rien mettre aussi

Cordialement,

Type libMonnaie 'type décrivant les paramètres d'un pays
libFranc As String 'libellé pour la monnaie principale, au singulier
libFrancs As String 'libellé pour la monnaie principale, au pluriel
libCentime As String 'libellé pour la monnaie secondaire, au singulier
libCentimes As String 'libellé pour la monnaie secondaire, au pluriel
sepDéci As String 'texte de séparation entre partie entière et décimale
nbreDéci As Integer 'nombre de décimales
estMon As Boolean 's'agit-il d'une monnaie
End Type

Function NombreTexte(valConv As String, Optional monnaieDéci As Variant, _
Optional convDéci As Variant) As String

Dim textMon As libMonnaie 'paramètres liés à la monnaie choisie
Dim valEnt As String 'partie entière du nombre
Dim valDéci As String 'partie décimale du nombre
Dim sepDéci As String * 1 'séparateur décimal de l'utilisateur

If Not (IsNumeric(valConv)) Then
NombreTexte = "Pas de nombre détecté"
Exit Function
End If
'If Len(valConv) > 16 Then
If Len(valConv) > 32 Then
NombreTexte = "#Hors Limites!"
Exit Function
End If
If Not IsError(Application.Search("E", valConv)) Then
NombreTexte = "#Hors limites!"
Exit Function
End If

If IsMissing(convDéci) Then convDéci = True
If convDéci = "" Then convDéci = True
If IsMissing(monnaieDéci) Then monnaieDéci = "F"
If monnaieDéci = "" Then monnaieDéci = "F"
If Not (IsNumeric(monnaieDéci)) Then
monnaieDéci = UCase(monnaieDéci)
textMon = ChoixLangue(monnaieDéci)
Else
textMon = ChoixLangue("Aucun")
textMon.nbreDéci = monnaieDéci
End If

If textMon.nbreDéci <> -1 Then
valConv = CStr(Application.Round(CDbl(valConv), textMon.nbreDéci))
If Not IsError(Application.Search("E", valConv)) Then
NombreTexte = "#Hors Limites!"
Exit Function
End If
End If

sepDéci = Application.International(xlDecimalSeparator)
If Fix(CDbl(valConv)) = CDbl(valConv) Then
valEnt = LTrim(valConv)
valDéci = "0"
Else
valEnt = LTrim(Left(valConv, Application.Search(sepDéci, valConv) - 1))
valDéci = Right(valConv, Len(valConv) - _
Application.Search(sepDéci, valConv))
If Len(valDéci) < textMon.nbreDéci Then
For i = 1 To textMon.nbreDéci - Len(valDéci)
valDéci = valDéci & "0"
Next
End If
End If

If CDbl(valConv) = 0 Then
NombreTexte = "Zéro" & textMon.libFranc
Else
NombreTexte = ""
If Left(valEnt, 1) = "-" Then
NombreTexte = "moins "
valEnt = Right(valEnt, Len(valEnt) - 1)
End If
If CDbl(valEnt) = 0 Then
NombreTexte = NombreTexte & "Zéro"
Else
NombreTexte = NombreTexte & ConvTexte(valEnt, textMon.estMon, False)
End If
If valEnt <> "un" And valEnt <> "1" Then
NombreTexte = NombreTexte & textMon.libFrancs
Else
NombreTexte = NombreTexte & textMon.libFranc
End If
If textMon.estMon Then
Do While Left(valDéci, 1) = "0" And Len(valDéci) > 1
valDéci = Right(valDéci, Len(valDéci) - 1)
Loop
End If
If valDéci <> "0" Then
NombreTexte = NombreTexte & textMon.sepDéci
If convDéci Then
NombreTexte = NombreTexte & ConvTexte(valDéci, textMon.estMon, True)
Else
NombreTexte = NombreTexte & valDéci
End If
If valDéci <> "un" And valDéci <> "1" Then
NombreTexte = NombreTexte & textMon.libCentimes
Else
NombreTexte = NombreTexte & textMon.libCentime
End If
End If
End If

End Function

Private Function ChoixLangue(ByVal codePays As String) As libMonnaie

Select Case codePays
Case "F"
ChoixLangue.libFranc = " franc"
ChoixLangue.libFrancs = " francs"
ChoixLangue.libCentime = " centime"
ChoixLangue.libCentimes = " centimes"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
'Comme pour le franc, les montants en euros s'expriment avec deux
'chiffres après la virgule parce que la plus petite subdivision sera
'le " cent " d'euro.
'les valeurs des billets (5, 10, 20, 50, 100, 200, 500 euros)
'et des pièces (1, 2, 5, 10, 20, 50 cents), et (1 et 2 euros)
'étaient définies par accord des Quinze dès 1995.
Case "€"
ChoixLangue.libFranc = " Euro"
ChoixLangue.libFrancs = " Euros"
ChoixLangue.libCentime = " centime" '(d'euro)"
ChoixLangue.libCentimes = " centimes" '(d'euro)"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
Case "$US"
ChoixLangue.libFranc = " dollar"
ChoixLangue.libFrancs = " dollars"
ChoixLangue.libCentime = " cent"
ChoixLangue.libCentimes = " cents"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
Case "£"
ChoixLangue.libFranc = " livre"
ChoixLangue.libFrancs = " livres"
ChoixLangue.libCentime = " penny"
ChoixLangue.libCentimes = " pence"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
Case "DM"
ChoixLangue.libFranc = " mark"
ChoixLangue.libFrancs = " marks"
ChoixLangue.libCentime = " pfennig"
ChoixLangue.libCentimes = " pfennige"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
Case "PTA"
ChoixLangue.libFranc = " peseta"
ChoixLangue.libFrancs = " pesetas"
ChoixLangue.libCentime = " céntimo"
ChoixLangue.libCentimes = " céntimos"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
Case "DTU"
ChoixLangue.libFranc = " dinar"
ChoixLangue.libFrancs = " dinars"
ChoixLangue.libCentime = " millime"
ChoixLangue.libCentimes = " millimes"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 3
ChoixLangue.estMon = True
Case "Y"
ChoixLangue.libFranc = " yen"
ChoixLangue.libFrancs = " yen"
ChoixLangue.libCentime = " sen"
ChoixLangue.libCentimes = " sen"
ChoixLangue.sepDéci = " et "
ChoixLangue.nbreDéci = 2
ChoixLangue.estMon = True
Case Else
ChoixLangue.libFranc = ""
ChoixLangue.libFrancs = ""
ChoixLangue.libCentime = ""
ChoixLangue.libCentimes = ""
ChoixLangue.sepDéci = " virgule "
ChoixLangue.nbreDéci = -1
ChoixLangue.estMon = False
End Select

End Function

Private Function ConvTexte(sourceConv As String, estMonnaie As Boolean, _
zéroGauche As Boolean) As String

ConvTexte = ""
Do While Left(sourceConv, 1) = "0"
If zéroGauche Then ConvTexte = ConvTexte & "zéro "
sourceConv = Right(sourceConv, Len(sourceConv) - 1)
Loop

Select Case Len(sourceConv)
Case 1, 2, 3
ConvTexte = ConvTexte & ConvCent(sourceConv, True)
Case 4, 5, 6
Select Case Left(sourceConv, Len(sourceConv) - 3)
Case "000"
ConvTexte = ConvTexte & ""
Case "1", "001"
If Right(sourceConv, 3) = "000" Then
'Dernir texte
ConvTexte = ConvTexte & "mille"
Else
ConvTexte = ConvTexte & "mille " & ConvTexte(Right(sourceConv, 3), estMonnaie, _
False)
End If
Case Else
If Right(sourceConv, 3) = "000" Then
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 3), _
False) & " mille"
Else
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 3), _
False) & " mille " & ConvTexte(Right(sourceConv, 3), _
estMonnaie, False)
End If
End Select
Case 7, 8, 9
Select Case Left(sourceConv, Len(sourceConv) - 6)
Case "000"
ConvTexte = ConvTexte & ""
Case "1", "001"
If Right(sourceConv, 6) = "000000" Then
ConvTexte = ConvTexte & "un million"
If estMonnaie Then ConvTexte = ConvTexte & " de"
Else
ConvTexte = ConvTexte & "un million " & ConvTexte(Right(sourceConv, 6), _
estMonnaie, False)
End If
Case Else
If Right(sourceConv, 6) = "000000" Then
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 6), _
True) & " millions"
If estMonnaie Then ConvTexte = ConvTexte & " de"
Else
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 6), _
True) & " millions " & ConvTexte(Right(sourceConv, 6), _
estMonnaie, False)
End If
End Select
Case 10, 11, 12
Select Case Left(sourceConv, Len(sourceConv) - 9)
Case "000"
ConvTexte = ConvTexte & ""
Case "1", "001"
If Right(sourceConv, 9) = "000000000" Then
ConvTexte = ConvTexte & "un milliard"
If estMonnaie Then ConvTexte = ConvTexte & " de"
Else
ConvTexte = ConvTexte & "un milliard " & ConvTexte(Right(sourceConv, 9), _
estMonnaie, False)
End If
Case Else
If Right(sourceConv, 9) = "000000000" Then
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 9), _
True) & " milliards"
If estMonnaie Then ConvTexte = ConvTexte & " de"
Else
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 9), _
True) & " milliards " & ConvTexte(Right(sourceConv, 9), _
estMonnaie, False)
End If
End Select
Case 13, 14, 15
Select Case Left(sourceConv, Len(sourceConv) - 12)
Case "000"
ConvTexte = ConvTexte & ""
Case "1", "001" '1 seul billion
If Right(sourceConv, 12) = "000000000000" Then
'Dernier texte
ConvTexte = ConvTexte & "un billion"
If estMonnaie Then ConvTexte = ConvTexte & " de"
Else
ConvTexte = ConvTexte & "un billion " & ConvTexte(Right(sourceConv, 12), _
estMonnaie, False)
End If
Case Else
If Right(sourceConv, 12) = "000000000000" Then
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 12), _
True) & " billions"
If estMonnaie Then ConvTexte = ConvTexte & " de"
Else
ConvTexte = ConvTexte & ConvCent(Left(sourceConv, Len(sourceConv) - 12), _
True) & " billions " & ConvTexte(Right(sourceConv, _
12), estMonnaie, False)
End If
End Select
Case Else
ConvTexte = "#Hors Limites!"
End Select

ConvTexte = LTrim(RTrim(ConvTexte))

End Function

Private Function ConvCent(source As String, estFinal As Boolean) As String

Dim tabUnit As Variant
Dim tabDixUnit As Variant
Dim tabDixaine As Variant

tabUnit = Array("zéro", "un", "deux", "trois", "quatre", "cinq", "six", _
"sept", "huit", "neuf")
tabDixUnit = Array("dix", "onze", "douze", "treize", "quatorze", "quinze", _
"seize", "dix-sept", "dix-huit", "dix-neuf")
tabDixaine = Array("", "dix", "vingt", "trente", "quarante", "cinquante", _
"soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")

Select Case Len(source)
Case 1
ConvCent = tabUnit(CDbl(source))
Case 2
Select Case Left(source, 1)
Case "0"
ConvCent = ConvCent(Right(source, 1), estFinal)
Case "1"
ConvCent = tabDixUnit(CDbl(Right(source, 1)))
Case "2", "3", "4", "5", "6"
Select Case Right(source, 1)
Case "0"
ConvCent = tabDixaine(CDbl(Left(source, 1)))
Case "1"
ConvCent = tabDixaine(CDbl(Left(source, 1))) & " et un"
Case Else
ConvCent = tabDixaine(CDbl(Left(source, 1))) & "-" & _
ConvCent(Right(source, 1), estFinal)
End Select
Case "7"
Select Case Right(source, 1)
Case "0"
ConvCent = tabDixaine(CDbl(Left(source, 1)))
Case "1"
ConvCent = "soixante et onze"
Case Else
ConvCent = "soixante-" & ConvCent("1" & Right(source, 1), _
estFinal)
End Select
Case "8"
If Right(source, 1) = "0" Then
If estFinal Then
ConvCent = "quatre-vingts"
Else
ConvCent = "quatre-vingt"
End If
Else
ConvCent = "quatre-vingt-" & ConvCent(Right(source, 1), estFinal)
End If
Case "9"
ConvCent = "quatre-vingt-" & ConvCent("1" & Right(source, 1), _
estFinal)
End Select
Case 3
Select Case Left(source, 1)
Case "0"
ConvCent = ConvCent(Right(source, 2), estFinal)
Case "1"
If Right(source, 2) = "00" Then
ConvCent = "cent"
Else
ConvCent = "cent " & ConvCent(Right(source, 2), estFinal)
End If
Case Else
If Right(source, 2) = "00" Then
If estFinal Then
ConvCent = ConvCent(Left(source, 1), estFinal) & " cents"
Else
ConvCent = ConvCent(Left(source, 1), estFinal) & " cent"
End If
Else
ConvCent = ConvCent(Left(source, 1), estFinal) & " cent " & _
ConvCent(Right(source, 2), estFinal)
End If
End Select
End Select
End Function
0