FONCTION DE CONVERTION (chiffre vers les lettres)

Signaler
Messages postés
29
Date d'inscription
mardi 25 juin 2002
Statut
Membre
Dernière intervention
31 mai 2003
-
Messages postés
1
Date d'inscription
lundi 15 novembre 2004
Statut
Membre
Dernière intervention
17 novembre 2004
-
Bonjour tout le monde,

J'aimerai savoir s'il existe une fonction dans en VBA qui permette de "convertir" des chiffres en lettres.
ex: 20 ---> VINGT

S'il n'y a pas de fonction spécifiques alors si vous pouvez me donner un code pour pouvoir faire la convertion.

Merci

Malcom78

8 réponses

Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
133
je ne connaîs aucune instruction qui puisse le faire... mais il est possible qu'elle existe.
Sinon, ce que tu peux faire, c'est effectuer la conversion toi-même par une instruction select case.
Ca risque être un peu long, mais c'est possible :
Tu devrais avoir environ une trentaine de "Case" possible :
0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,30
40,50,60,70,80,90,100,1000,1000000,1000000000

DARK SIDIOUS
0
Messages postés
29
Date d'inscription
mardi 25 juin 2002
Statut
Membre
Dernière intervention
31 mai 2003

Merci pour ta réponse,
ouais j'avais pensé a faire des select case, mais ce que je vois pas. C'est comment je vais faire pour traiter les nombres comme 1234,11.
Euh je sais pas si tu vois ce que je veux dire mais si t'as bsn de + de renseignement dis le moi.
Merci

Malcom78
0
Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
133
C'est tout simple. Pout ton exemple, ca donne ceci

Dim STR_Valeur_nombre as string
Dim STR_Valeur_Texte as string
Dim INT_Nombre as integer

INT_Nombre = 1234,11

STR_Valeur_Nombre = str(int_nombre)

select case left(STR_Valeur_Nombre,1)

Case "1"

STR_Valeur_Texte = "Mille "

end select

select case Mid(STR_Valeur_Nombre,1,1)

Case "2"

Str_valeur_nombre = str_valeur_nombre & "Deux cent "

end select

Etc., Etc...

DARK SIDIOUS
0
Messages postés
29
Date d'inscription
mardi 25 juin 2002
Statut
Membre
Dernière intervention
31 mai 2003

Merci bcp, je vais faire comme ca c'est vrai que c'est une bonne méthode.
Je t'appelle si j'ai un probl
@+
Malcom78
0
Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
133
En fait, le problème que tu as posé est assez interessant, et je crois que je vais publier une source la dessus ;-)
Par contre, je ne sais pas quand je vais pouvoir m'y atteler, vu que j'ai déjà 3 projets à faire...

DARK SIDIOUS
0
Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
133
Je crois bien que je vais publier une source la dessus, car il s'agit d'un sujet interessant, qui peut servir à beaucoup de monde :-)

Par contre, je ne sais pas quand je pourrais publier cette source, car j'ai actuellement 3 projet à terminer...

DARK SIDIOUS
0
Messages postés
1
Date d'inscription
lundi 8 décembre 2003
Statut
Membre
Dernière intervention
11 décembre 2003

Bonjour,

Mon souhait est d'apprendre manipuler VB, mais je n'ai pas le moyen d'avoir le logiciel à question pour m'exercer de temps à temps.
Je vous demande de me venir en aide, pour contact: kashindi@distributel.net

Merci d'avance
Pablo
0
Messages postés
1
Date d'inscription
lundi 15 novembre 2004
Statut
Membre
Dernière intervention
17 novembre 2004

Et bilingue en plus...
Adaptable à n'importe quelle autre langue en alphabet latin.

Option Explicit

Const Français = 1
Const Allemand = 2

Dim TableUnitésFR(0 To 19) As String
Dim TableDizainesFR(0 To 9) As String
Dim TableUnitésDE(0 To 19) As String
Dim TableDizainesDE(0 To 9) As String
Dim TablesInitialisées As Integer
'
'----------------------------------------------------------------------------
'
Static Sub InitTables()

TableUnitésFR(0) = ""
TableUnitésFR(1) = " un"
TableUnitésFR(2) = " deux"
TableUnitésFR(3) = " trois"
TableUnitésFR(4) = " quatre"
TableUnitésFR(5) = " cinq"
TableUnitésFR(6) = " six"
TableUnitésFR(7) = " sept"
TableUnitésFR(8) = " huit"
TableUnitésFR(9) = " neuf"
TableUnitésFR(10) = " dix"
TableUnitésFR(11) = " onze"
TableUnitésFR(12) = " douze"
TableUnitésFR(13) = " treize"
TableUnitésFR(14) = " quatorze"
TableUnitésFR(15) = " quinze"
TableUnitésFR(16) = " seize"
TableUnitésFR(17) = " dix sept"
TableUnitésFR(18) = " dix huit"
TableUnitésFR(19) = " dix neuf"

TableDizainesFR(0) = ""
TableDizainesFR(1) = ""
TableDizainesFR(2) = " vingt"
TableDizainesFR(3) = " trente"
TableDizainesFR(4) = " quarante"
TableDizainesFR(5) = " cinquante"
TableDizainesFR(6) = " soixante"
TableDizainesFR(7) = " soixante"
TableDizainesFR(8) = " quatre vingt"
TableDizainesFR(9) = " quatre vingt"

TableUnitésDE(0) = ""
TableUnitésDE(1) = "ein"
TableUnitésDE(2) = "zwei"
TableUnitésDE(3) = "drei"
TableUnitésDE(4) = "vier"
TableUnitésDE(5) = "fünf"
TableUnitésDE(6) = "sechs"
TableUnitésDE(7) = "sieben"
TableUnitésDE(8) = "acht"
TableUnitésDE(9) = "neun"
TableUnitésDE(10) = "zehn"
TableUnitésDE(11) = "elf"
TableUnitésDE(12) = "zwölf"
TableUnitésDE(13) = "dreizehn"
TableUnitésDE(14) = "vierzehn"
TableUnitésDE(15) = "fünfzehn"
TableUnitésDE(16) = "sechszehn"
TableUnitésDE(17) = "siebzehn"
TableUnitésDE(18) = "achtzehn"
TableUnitésDE(19) = "neunzehn"

TableDizainesDE(0) = ""
TableDizainesDE(1) = ""
TableDizainesDE(2) = "zwanzig"
TableDizainesDE(3) = "dreizig"
TableDizainesDE(4) = "vierzig"
TableDizainesDE(5) = "fünfzig"
TableDizainesDE(6) = "sechzig"
TableDizainesDE(7) = "siebzig"
TableDizainesDE(8) = "achtzig"
TableDizainesDE(9) = "neunzig"

TablesInitialisées = True

End Sub
'
'----------------------------------------------------------------------------
'
Function EcrireEnLettre(Value As Variant, NomUnité As String, NomSousMultiple As String, Langue As Integer) As String
'
' Renvoie le texte en lettre d'un nombre
'
Dim Strings As String

Strings = " "

If IsNumeric(Value) _
Then
If Not TablesInitialisées _
Then
InitTables
End If

Select Case Langue

Case Français
Strings = EcrireEnLettreFrançais(Value, NomUnité, NomSousMultiple)

Case Allemand
Strings = EcrireEnLettreAllemand(Value, NomUnité, NomSousMultiple)

Case Else

End Select
End If

EcrireEnLettre = PremièreLettreMajuscule(Strings)

End Function
'
'----------------------------------------------------------------------------
'
Function EcrireEnLettreFrançais(Value As Variant, NomUnité As String, NomSousMultiple As String) As String

Dim Strings As String
Dim L_Valeur As Long
Dim Millions As Long
Dim Milliers As Long
Dim Unités As Long
Dim Décimales As Long

On Error GoTo gesterreur

Strings = ""

L_Valeur = Fix(Abs(Value * 100))
Décimales = L_Valeur Mod 100
L_Valeur = Fix(L_Valeur / 100)


Millions = Fix(L_Valeur / 1000000)
L_Valeur = L_Valeur - (Fix(Millions) * 1000000)
Milliers = Fix(L_Valeur / 1000)
L_Valeur = L_Valeur - (Fix(Milliers) * 1000)
Unités = L_Valeur

If Millions > 0 _
Then
Strings = Strings & EcrireNombre3ChFrançais(Millions) & " million"
If Millions > 1 _
Then
Strings = Strings & "s"
End If
End If

If Milliers > 0 _
Then
If Milliers > 1 _
Then
Strings = Strings & EcrireNombre3ChFrançais(Milliers) & " mille"
Else
Strings = Strings & " mille"
End If
End If

If Unités > 0 _
Then
Strings = Strings & EcrireNombre3ChFrançais(Unités)
End If

Strings = Trim(Strings)

If Right(Strings, 7) = "million" _
Or Right(Strings, 8) = "millions" _
Then
Strings = Strings & " de"
End If

If Right(Strings, 4) = "cent" _
Or Right(Strings, 12) = "quatre vingt" _
Then
Strings = Strings & "s"
End If

If Value >= 1 _
Then
Strings = Strings & " " & NomUnité
If Value >= 2 _
Then
Strings = Strings & "s"
End If
End If

If Décimales > 0 _
Then

Strings = Strings & EcrireNombre3ChFrançais(CInt(Décimales))
Strings = Trim(Strings)

If Right(Strings, 12) = "quatre vingt" _
Then
Strings = Strings & "s"
End If

Strings = Strings & " " & NomSousMultiple

If Décimales > 1 _
Then
Strings = Strings & "s"
End If

End If

EcrireEnLettreFrançais = Strings

Exit Function
'
'
'
gesterreur:

MsgBox "Erreur conversion " & Error$()

End Function
'
'----------------------------------------------------------------------------
'
Function EcrireNombre3ChFrançais(Value As Long) As String

Dim Strings As String
Dim L_Valeur As Integer
Dim Unités As Integer
Dim Centaines As Integer
Dim Dizaines As Integer

On Error GoTo gesterreur

Strings = ""

If Value >= 1000 _
Then
MsgBox "Valeur incorrecte, " & Str(Value)
Exit Function
End If

L_Valeur = Value
Centaines = Fix(L_Valeur / 100)
L_Valeur = L_Valeur - (100 * Centaines)
Dizaines = Fix(L_Valeur / 10)
L_Valeur = L_Valeur - (10 * Dizaines)
Unités = L_Valeur


If Centaines > 0 _
Then
If Centaines > 1 _
Then
Strings = TableUnitésFR(Centaines)
End If

Strings = Strings & " cent"
End If

Select Case Dizaines
Case 0:
Strings = Strings & TableUnitésFR(Unités)

Case 1:
Strings = Strings & TableUnitésFR(10 + Unités)

Case 2, 3, 4, 5, 6, 7:
Strings = Strings & TableDizainesFR(Dizaines)
If Unités = 1 _
Then
Strings = Strings & " et"
End If

If Dizaines = 7 _
Then
Strings = Strings & TableUnitésFR(10 + Unités)
Else
Strings = Strings & TableUnitésFR(Unités)
End If

Case 8, 9:
Strings = Strings & TableDizainesFR(Dizaines)

If Dizaines = 9 _
Then
Strings = Strings & TableUnitésFR(10 + Unités)
Else
Strings = Strings & TableUnitésFR(Unités)
End If

End Select

EcrireNombre3ChFrançais = Strings

Exit Function
'
'
'
gesterreur:

MsgBox "Erreur dans EcrireNombre3ChFrançais " & Error$()

End Function
'
'----------------------------------------------------------------------------
'
Function PremièreLettreMajuscule(Strings As String) As String

Dim Lg As Integer
Dim PremièreLettre As String
Dim Reste As String

Lg = Len(Strings)
PremièreLettre = UCase(Left(Strings, 1))
Reste = Right(Strings, Lg - 1)
PremièreLettreMajuscule = PremièreLettre & Reste


End Function
'
'----------------------------------------------------------------------------
'
Function EcrireEnLettreAllemand(Value As Variant, NomUnité As String, NomSousMultiple As String) As String

Dim Strings As String
Dim L_Valeur As Long
Dim Millions As Long
Dim Milliers As Long
Dim Unités As Long
Dim Décimales As Long

On Error GoTo gesterreur

Strings = ""

L_Valeur = Fix(Abs(Value * 100))
Décimales = L_Valeur Mod 100
L_Valeur = Fix(L_Valeur / 100)


Millions = Fix(L_Valeur / 1000000)
L_Valeur = L_Valeur - (Fix(Millions) * 1000000)
Milliers = Fix(L_Valeur / 1000)
L_Valeur = L_Valeur - (Fix(Milliers) * 1000)
Unités = L_Valeur

If Millions > 0 _
Then
Strings = Strings & EcrireNombre3ChAllemand(Millions) & "million"
If Millions > 1 _
Then
Strings = Strings & "en"
End If
End If

If Milliers > 0 _
Then
If Milliers > 1 _
Then
Strings = Strings & EcrireNombre3ChAllemand(Milliers) & "tausend"
Else
Strings = Strings & "tausend"
End If
End If

If Unités > 0 _
Then
Strings = Strings & EcrireNombre3ChAllemand(Unités)
End If

Strings = Trim(Strings)

If Value >= 1 _
Then
Strings = Strings & " " & NomUnité & " "
End If

If Décimales > 0 _
Then

Strings = Strings & EcrireNombre3ChAllemand(CInt(Décimales))
Strings = Trim(Strings)

Strings = Strings & " " & NomSousMultiple

End If

EcrireEnLettreAllemand = Strings

Exit Function
'
'
'
gesterreur:

MsgBox "Erreur conversion " & Error$()

End Function
'
'----------------------------------------------------------------------------
'
Function EcrireNombre3ChAllemand(Value As Long) As String

Dim Strings As String
Dim L_Valeur As Integer
Dim Unités As Integer
Dim Centaines As Integer
Dim Dizaines As Integer

On Error GoTo gesterreur

Strings = ""

If Value >= 1000 _
Then
MsgBox "Valeur incorrecte, " & Str(Value)
Exit Function
End If

L_Valeur = Value
Centaines = Fix(L_Valeur / 100)
L_Valeur = L_Valeur - (100 * Centaines)
Dizaines = Fix(L_Valeur / 10)
L_Valeur = L_Valeur - (10 * Dizaines)
Unités = L_Valeur


If Centaines > 0 _
Then
If Centaines > 1 _
Then
Strings = TableUnitésDE(Centaines)
End If

Strings = Strings & "hundert"
End If

Select Case Dizaines
Case 0:
Strings = Strings & TableUnitésDE(Unités)

Case 1:
Strings = Strings & TableUnitésDE(10 + Unités)

Case 2, 3, 4, 5, 6, 7, 8, 9:
If Unités >= 1 _
Then
Strings = Strings & TableUnitésDE(Unités) & "und"
End If

Strings = Strings & TableDizainesDE(Dizaines)

End Select

EcrireNombre3ChAllemand = Strings

Exit Function
'
'
'
gesterreur:

MsgBox "Erreur dans EcrireNombre3ChAllemand " & Error$()

End Function
'
'----------------------------------------------------------------------------
'
0