1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Divers
  5. Traduire des gros chiffres en lettres avec correction ortographique

Traduire des gros chiffres en lettres avec correction ortographique

0/5 (35 avis)

Vue 18 736 fois - Téléchargée 255 fois

Télécharger le projet
Commenter

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

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
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Lily2Rose Messages postés 10 Date d'inscription mardi 24 novembre 2009 Statut Membre Dernière intervention 31 mars 2010
31 mars 2010 à 17:58
Merci VICOSTA comme même.
Bonne continuation!

Cordialement Lily2Rose.
vicosta Messages postés 178 Date d'inscription lundi 5 juin 2006 Statut Membre Dernière intervention 30 novembre 2011
18 mars 2010 à 22:29
désolé Lily2Rose, sous vb6 ça fonctionne bien, peut être qu'un autre membre puisse t'aider en vb.net...
bonne chance !
Lily2Rose Messages postés 10 Date d'inscription mardi 24 novembre 2009 Statut Membre Dernière intervention 31 mars 2010
16 mars 2010 à 13:56
ça ne fonctionna plus,je suis sous VB.NET 2008. même si après la conversion faite implicitement avec le vb.net 2008.
vicosta Messages postés 178 Date d'inscription lundi 5 juin 2006 Statut Membre Dernière intervention 30 novembre 2011
7 mars 2010 à 21:28
Voila Lily2Rose, j'ai mis en haut un ZIP du projet pour le test. J'espère que ça va aller
Lily2Rose Messages postés 10 Date d'inscription mardi 24 novembre 2009 Statut Membre Dernière intervention 31 mars 2010
2 mars 2010 à 16:42
Bonjour;
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 :).
Afficher les 35 commentaires
S'inscrire maintenant

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.

Du même auteur (vicosta)