Soyez le premier à donner votre avis sur cette source.
Vue 120 344 fois - Téléchargée 13 755 fois
Public Function NbVersTexte(ValNum As Double) As String Static Unites(0 To 9) As String Static Dixaines(0 To 9) As String Static LesDixaines(0 To 9) As String Static Milliers(0 To 4) As String Dim i As Integer Dim nPosition As Integer Dim ValNb As Integer Dim LesZeros As Integer Dim strResultat As String Dim strTemp As String Dim tmpBuff As String Unites(0) = "zero" Unites(1) = "un" Unites(2) = "deux" Unites(3) = "trois" Unites(4) = "quatre" Unites(5) = "cinq" Unites(6) = "six" Unites(7) = "sept" Unites(8) = "huit" Unites(9) = "neuf" Dixaines(0) = "dix" Dixaines(1) = "onze" Dixaines(2) = "douze" Dixaines(3) = "treize" Dixaines(4) = "quatorze" Dixaines(5) = "quinze" Dixaines(6) = "seize" Dixaines(7) = "dix-sept" Dixaines(8) = "dix-huit" Dixaines(9) = "dix-neuf" LesDixaines(0) = "" LesDixaines(1) = "dix" LesDixaines(2) = "vingt" LesDixaines(3) = "trente" LesDixaines(4) = "quarante" LesDixaines(5) = "cinquante" LesDixaines(6) = "soixante" LesDixaines(7) = "soixante-dix" LesDixaines(8) = "quatre-vingt" LesDixaines(9) = "quatre-vingt-dix" Milliers(0) = "" Milliers(1) = "mille" Milliers(2) = "million" Milliers(3) = "millard" Milliers(4) = "mille" On Error GoTo NbVersTexteError strTemp = CStr(Int(ValNum)) For i = Len(strTemp) To 1 Step -1 ValNb = Val(Mid$(strTemp, i, 1)) nPosition = (Len(strTemp) - i) + 1 Select Case (nPosition Mod 3) Case 1 LesZeros = False If i = 1 Then If ValNb > 1 Then tmpBuff = Unites(ValNb) & " " Else tmpBuff = "" End If ElseIf Mid$(strTemp, i - 1, 1) = "1" Then tmpBuff = Dixaines(ValNb) & " " i = i - 1 ElseIf Mid$(strTemp, i - 1, 1) = "9" Then tmpBuff = LesDixaines(8) & " " & Dixaines(ValNb) & " " i = i - 1 ElseIf Mid$(strTemp, i - 1, 1) = "7" Then tmpBuff = LesDixaines(6) & " " & Dixaines(ValNb) & " " i = i - 1 ElseIf ValNb > 0 Then tmpBuff = Unites(ValNb) & " " Else LesZeros = True If i > 1 Then If Mid$(strTemp, i - 1, 1) <> "0" Then LesZeros = False End If End If If i > 2 Then If Mid$(strTemp, i - 2, 1) <> "0" Then LesZeros = False End If End If tmpBuff = "" End If If LesZeros = False And nPosition > 1 Then tmpBuff = tmpBuff & Milliers(nPosition / 3) & " " End If strResultat = tmpBuff & strResultat Case 2 If ValNb > 0 Then strResultat = LesDixaines(ValNb) & " " & strResultat End If Case 0 If ValNb > 0 Then If ValNb > 1 Then strResultat = Unites(ValNb) & " cent " & strResultat Else strResultat = "cent " & strResultat End If End If End Select Next i If Len(strResultat) > 0 Then strResultat = UCase$(Left$(strResultat, 1)) & Mid$(strResultat, 2) End If EndNbVersTexte: NbVersTexte = strResultat Exit Function NbVersTexteError: strResultat = "Une Erreur !" Resume EndNbVersTexte End Function ' Puis pour l'utiliser mettez ce code dans votre Formulaire Private Sub Command1_Click() Text2.Text = NbVersTexte(Text1.Text) End Sub ' N.B : Ce code à été adapté du code de Jim Youmans pour être utiliser en francais car les chiffres comme 75 et 95 ne s'affiche pas de la même façon.
BRAVO
et merci
je cherche a transfer les chiffre en lettre sur access
merci d'avance
mon e'mail : etresolo@yahoo.fr
merci en tout cas pour ce script.
-----------------
Imports Microsoft.VisualBasic
Public Module Utils
Public Function Nombre2Texte(ByVal ValNum As Double) As String
Static Unites(9) As String
Static Dixaines(9) As String
Static LesDixaines(9) As String
Static Milliers(4) As String
Dim i As Integer
Dim nPosition As Integer
Dim ValNb As Integer
Dim LesZeros As Integer
Dim strResultat As String
Dim strTemp As String
Dim tmpBuff As String
Unites(0) = "zero"
Unites(1) = "un"
Unites(2) = "deux"
Unites(3) = "trois"
Unites(4) = "quatre"
Unites(5) = "cinq"
Unites(6) = "six"
Unites(7) = "sept"
Unites(8) = "huit"
Unites(9) = "neuf"
Dixaines(0) = "dix"
Dixaines(1) = "onze"
Dixaines(2) = "douze"
Dixaines(3) = "treize"
Dixaines(4) = "quatorze"
Dixaines(5) = "quinze"
Dixaines(6) = "seize"
Dixaines(7) = "dix-sept"
Dixaines(8) = "dix-huit"
Dixaines(9) = "dix-neuf"
LesDixaines(0) = ""
LesDixaines(1) = "dix"
LesDixaines(2) = "vingt"
LesDixaines(3) = "trente"
LesDixaines(4) = "quarante"
LesDixaines(5) = "cinquante"
LesDixaines(6) = "soixante"
LesDixaines(7) = "soixante-dix"
LesDixaines(8) = "quatre-vingt"
LesDixaines(9) = "quatre-vingt-dix"
Milliers(0) = ""
Milliers(1) = "mille"
Milliers(2) = "million"
Milliers(3) = "millard"
Milliers(4) = "mille"
On Error GoTo NbVersTexteError
strTemp = CStr(Int(ValNum))
If ValNum 0 Or ValNum 1 Then
strResultat = Unites(ValNum)
End If
If ValNum = 1000
Return Milliers(1)
End If
For i = Len(strTemp) To 1 Step -1
ValNb = Val(Mid(strTemp, i, 1))
nPosition = (Len(strTemp) - i) + 1
Select Case (nPosition Mod 3)
Case 1
LesZeros = False
If i = 1 Then
If ValNb >= 1 Then
tmpBuff = Unites(ValNb) & " "
Else
tmpBuff = ""
End If
ElseIf Mid(strTemp, i - 1, 1) = "1" Then
tmpBuff = Dixaines(ValNb) & " "
i = i - 1
ElseIf Mid(strTemp, i - 1, 1) = "9" Then
tmpBuff = LesDixaines(8) & " " & Dixaines(ValNb) & " "
i = i - 1
ElseIf Mid(strTemp, i - 1, 1) = "7" Then
If ValNb = 1 Then
tmpBuff = LesDixaines(6) & " et " & Dixaines(ValNb) & " "
Else
tmpBuff = LesDixaines(6) & " " & Dixaines(ValNb) & " "
End If
i = i - 1
ElseIf ValNb > 0 Then
tmpBuff = Unites(ValNb) & " "
Else
LesZeros = True
If i > 1 Then
If Mid(strTemp, i - 1, 1) <> "0" Then
LesZeros = False
End If
End If
If i > 2 Then
If Mid(strTemp, i - 2, 1) <> "0" Then
LesZeros = False
End If
End If
tmpBuff = ""
End If
If LesZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & Milliers(nPosition / 3) & " "
End If
strResultat = tmpBuff & strResultat
Case 2
If ValNb > 0 Then
If strResultat = "un " And ValNb <> 8 Then
strResultat = LesDixaines(ValNb) & " et " & strResultat
Else
strResultat = LesDixaines(ValNb) & " " & strResultat
End If
End If
Case 0
If ValNb > 0 Then
If ValNb > 1 Then
strResultat = Unites(ValNb) & " cent " & strResultat
Else
strResultat = "cent " & strResultat
End If
End If
End Select
Next i
'If Len(strResultat) > 0 Then
' strResultat = UCase$(Left$(strResultat, 1)) & Mid(strResultat, 2)
'End If
EndNbVersTexte:
Nombre2Texte = strResultat
Exit Function
NbVersTexteError:
Nombre2Texte = "!! Erreur !!"
Resume EndNbVersTexte
End Function
End Module
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.