FONCTION DE CONVERTION (chiffre vers les lettres)

Question

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

cs_DARKSIDIOUS · Answer

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

malcom78 · Answer

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

cs_DARKSIDIOUS · Answer

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

malcom78 · Answer

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

cs_DARKSIDIOUS · Answer

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

cs_DARKSIDIOUS · Answer

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

cs_Pablo35 · Answer

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

jpcipm · Answer

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
'
'----------------------------------------------------------------------------
'

FONCTION DE CONVERTION (chiffre vers les lettres)

8 réponses

Discussions similaires