Traduire des gros chiffres en lettres avec correction ortographique
Soyez le premier à donner votre avis sur cette source.
Vue 18 248 fois - Téléchargée 228 fois
Description
Encore une version, mais celle-ci accepte des valeures jusqu'aux quadrillions et
la correction ortographique a été poussé selon les normes en vigueur, mais j'attends vos commentaires
Pour tester, ajouter 3 textbox à une feuille
Text1: pour insérer une valeur
Text2: pour recevoir le resultat
Text3: pour afficher le format du nombre
Propriétés pour Text2:
Multiline=True
ScrollBars=Vertical
la correction ortographique a été poussé selon les normes en vigueur, mais j'attends vos commentaires
Source / Exemple :
Private Sub Text1_Change() Text2 = ConvNumToAlpha(Text1) End Sub Function ConvNumToAlpha(Nombre, Optional Def_EUR__ID1_CHF__ID2_CAD As Integer) As String ' MAJ: http://www.vbfrance.com/codes/TRADUIRE-GROS-CHIFFRES-LETTRES-AVEC-CORRECTION-ORTOGRAPHIQUE_47934.aspx ' Supporte plusieures devises ainsi que des nombres jusqu'aux quadrillions ' Tout est dans cette fonction, il n'est pas nécessaire de faire des déclarations au niveau du module Dim sFormat As String, sTraducteur As String, Chiffre As Integer, ChiffreMem As Integer Dim I As Integer, X As Integer, sAtome As String, S As String, Group As Integer, GroupMem As Integer Static CENTAINNES, DIZAINNES, UNITES, DIVERS, PARTICULIER Static DEVISE, CouranteDevise As Integer, Updated As Boolean ' If CouranteDevise <> Def_EUR__ID1_CHF__ID2_CAD Then Updated = False 'changement de divise, on doit alors re-initialiser les variables statiques CouranteDevise = Def_EUR__ID1_CHF__ID2_CAD End If If Not Updated Then 'afin d'économiser le CPU, les tableaux suivants sont mis à jour seulement quand nécessaire Updated = True DEVISE = Split(" Euro, Franc, Dollar", ",") UNITES = Split(", un, deux, trois, quatre, cinq, six, sept, huit, neuf, dix, onze, douze, treize, quatorze, quinze, seize, dix-sept, dix-huit, dix-neuf", ",") DIZAINNES = Split(", dix, vingt, trente, quarante, cinquante, soixante, soixante-dix, quatre-vingt, quatre-vingt-dix", ",") CENTAINNES = Split(", cent, deux cent, trois cent, quatre cent, cinq cent, six cent, sept cent, huit cent, neuf cent", ",") PARTICULIER = Split(Chr(71) & Chr(80) & Chr(81) & ", soixante et onze, quatre-vingts, quatre-vingt-un", ",") DIVERS = Split("MmiBbTQ., mille, million, milliard, billion, billiard, trillion, quadrillion, Euro ", ",") If CouranteDevise Then 'Francs suisses, Dollars canadians DIZAINNES(7) = " septante": DIZAINNES(8) = " huitante": DIZAINNES(9) = " nonante": ReDim PARTICULIER(0) End If End If On Error GoTo Fin '-------------------------------------CDUQCDUTCDUbCDUBCDUiCDUmCDUMCDU.DU----------------------------- sFormat = Trim(Format$(CDec(Nombre), "### ### ### ### ### ### ### ###.00")) ' Traduire notre nombre au format sTraducteur = Right$("CDUQCDUTCDUbCDUBCDUiCDUmCDUMCDU.DU", Len(sFormat)) ' compatible avec 'sTraducteur' Text3 = sFormat If Int(Nombre) = 0 Then S = "Zéro" Group = 2 X = InStr(sFormat, " ") If X Then Group = Val(Mid(sFormat, 1, X)) For I = 1 To Len(sFormat) Chiffre = Val(Mid$(sFormat, I, 1)) sAtome = Mid$(sTraducteur, I, 1) Select Case sAtome Case "U" ' les unités If Group = 1 And Mid(sTraducteur, I + 1, 1) = "M" Then ' éviter les 'Un mille' ElseIf Chiffre = 1 And ChiffreMem > 0 Then ' vingt et un, trente et un S = S & " et" & UNITES(Chiffre) ElseIf Chiffre > 1 And ChiffreMem > 0 Then ' vingt-deux, trente-trois S = S & "-" & LTrim(UNITES(Chiffre)) ElseIf Chiffre Then If Mid(sFormat, I + 1, 1) = "." And GroupMem = 0 And Nombre > 1000 Then S = S & " et" S = S & UNITES(Chiffre) End If Case "D" ' les dizainnes X = InStr(PARTICULIER(0), Chr(Val(Mid$(sFormat, I, 2)))) If X Then 'soixante et onze, quatre-vingts, quatre-vingt-un S = S & PARTICULIER(X) I = I + 1 'éviter les prochainnes unités ElseIf CouranteDevise = 0 And InStr("79", CStr(Chiffre)) > 0 And Val(Mid$(sFormat, I + 1, 1)) > 0 Then S = S & DIZAINNES(Chiffre - 1) I = I + 1 'éviter les prochainnes unités ChiffreMem = Chiffre Chiffre = Val(Mid$(sFormat, I, 1)) If ChiffreMem = 1 Then ' onze, douze S = S & UNITES(Chiffre + 10) Else ' soixante-onze, quatre-vingt-douze S = S & "-" & LTrim(UNITES(Chiffre + 10)) End If ElseIf Chiffre = 1 Then S = S & UNITES(Val(Mid$(sFormat, I + 1, 1) + 10)) I = I + 1 ElseIf Chiffre Then S = S & DIZAINNES(Chiffre) End If Case "C" ' les centainnes GroupMem = Group Group = Val(Mid(sFormat, I, 3)) If Chiffre Then S = S & CENTAINNES(Chiffre) If Mid$(sFormat, I + 1, 3) = "00." And Chiffre > 1 Then S = S & "s" 'pluriel sur les centainnes: 600 = six cents, 601= six cent un End If End If Case Else X = InStr(DIVERS(0), sAtome) If X > 0 And Group > 0 Then S = S & DIVERS(X) If Group > 1 And InStr("miBbTQ", sAtome) > 0 Then S = S & "s" ' traiter les pluriels de million, milliard et billion End If ElseIf sAtome = "." Then S = S & DIVERS(X) End If End Select ChiffreMem = Chiffre ' mémoriser ce dernier chiffre Next 'Autres rectifications: If InStr(sFormat, ".00") = 0 Then S = S & " Cts" S = Replace(S, "Euro ", "Euro et") End If If Int(Nombre) <> 1 Then S = Replace$(S, "Euro", "Euros") ' pluriel d'Euro If Group = 0 And InStr(S, "mille Euro") = 0 Then ' un million d'Euros S = Replace$(S, "Euros", "d'Euros") End If If CouranteDevise Then ' autres que l'Euro S = Replace(S, "d'Euros", "de" & DEVISE(CouranteDevise) & "s") S = Replace(S, " Euros", DEVISE(CouranteDevise) & "s") S = Replace(S, " Euro ", DEVISE(CouranteDevise) & " ") End If S = LTrim$(S) ConvNumToAlpha = UCase(Mid(S, 1, 1)) & Mid(S, 2) ' mettre première lettre en majuscules Exit Function Fin: If Len(Trim(Nombre)) Then MsgBox Err.Description, vbCritical + vbSystemModal End Function
Conclusion :
Pour tester, ajouter 3 textbox à une feuille
Text1: pour insérer une valeur
Text2: pour recevoir le resultat
Text3: pour afficher le format du nombre
Propriétés pour Text2:
Multiline=True
ScrollBars=Vertical
Codes Sources
A voir également
- Traduire des gros chiffres en lettres avec correction ortographique
- Traduire des chiffre en lettre ✓ - Forum - Java
- Telecharger macro excel convertir chiffre en lettre arabe - Guide
- Convertir chiffre en lettre arabe - Guide
- Script php chiffre en lettre - Guide
- Convertir chiffre en lettre arabe delphi ✓ - Forum - Delphi / Pascal
Commentaires
Bonne continuation!
Cordialement Lily2Rose.
bonne chance !
tout d'abord merci VICOSTA pour cette source.
Je voudrais bien executer ce code mais ca marche pas sur mon poste .Ca est due au variable qui figurent sur ce code je sais plus avec quoi je vais les remplacer.SVP aidez moi à executer ce progamme dont j'en ai besoin.
Si c'est possible passe moi ton E-mail pour m'aider.
Merci d'avance.
et BONNE COURAGE :).
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.