VB6/VBA Transformer nombre en texte

Dernière mise à jour le 2 mars 2009 à 19:18 par Ssylvainsab
Publié par lermite222


Introduction


La fonction peut transformer des nombres de l'unité jusqu'à 999 tera.
Prend en compte la syntaxe pour le français de France, de Belgique et de Suisse.




Préliminaires VB6

  • 1 forme
  • 1 label : name = label1
  • OptionButton1 : name = OptionButton1 : Index = 0 : caption = "France"
  • OptionButton1 : name = OptionButton1 : Index = 1 : caption = "Belgique"
  • OptionButton1 : name = OptionButton1 : Index = 2 : caption = "Suisse"
  • 1 texteBox : name = TextBox1 : Text = ""
  • 1 CommandButton : Name = Command1 : Caption = "Envoyer"
  • 1 module : name = Module1

Dans le module de la forme


Private Sub Command1_Click()
    Label1.Caption = LesMilliers(Text1.Text)
End Sub

Private Sub Form_Load()
    IniteVar
    Label1.Caption = LesMilliers("162")
End Sub

Private Sub Option1_Click(Index As Integer)
    pays = Index
    IniteVar
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Label1.Caption = LesMilliers(Text1.Text)
    End If
End Sub

Dans Module1


Public pays As Integer
Private Unite(19) As String 
Private Dixaines(2 To 9) As String 

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

Dixaines(2) = "vingt "
Dixaines(3) = "trente "
Dixaines(4) = "quarante "
Dixaines(5) = "cinquante "
Dixaines(6) = "soixante "

Select Case pays
Case 0 'France
    Dixaines(7) = "soixante-dix "
    Dixaines(8) = "quatre-vingts "
    Dixaines(9) = "quatre-vingts-dix "
Case 1 'Belge
    Dixaines(7) = "septante "
    Dixaines(8) = "quatre-vingts "
    Dixaines(9) = "nonante "
Case 2 'suisse
    Dixaines(7) = "septante "
    Dixaines(8) = "huitante "
    Dixaines(9) = "nonante "
End Select

End Sub
Function LesMilliers(Nombre As String) As String

Dim i As Integer, e As Integer, Txt As String
Dim ValNb(6) As Double
Dim strResultat(6) As String
Dim strTemp As String
Dim a As String

    If Val(Nombre) < 1 Then LesMilliers = "Zéro": Exit Function
reco:
    If Len(Nombre) / 3 <> Int(Len(Nombre) / 3) Then
        Nombre = "0" & Nombre
        GoTo reco
    End If
    e = (Len(Nombre) / 3)
    For i = 0 To e - 1
        Txt = Mid(Nombre, (i * 3) + 1, 3)
        ValNb(i) = Val(Txt)
        strResultat(i) = Centaine(Txt)
    Next i
    i = 0
    If e > 4 Then téra
        strTemp = strResultat(0) & "téra "
        i = i + 1
    End If
    If e > 3 Then 'milliard
        If ValNb(i) = 1 Then a = "milliard " Else a = "milliards "
        strTemp = strTemp & strResultat(i) & "milliard "
        i = i + 1
    End If
    If e > 2 Then 'million
        If ValNb(i) = 1 Then a = "million " Else a = "millions "
        strTemp = strTemp & strResultat(i) & a
        i = i + 1

    End If
    If e > 1 Then 'millier
        If ValNb(i) = 1 Then
            strTemp = strTemp & "mille "
        Else
            strTemp = strTemp & strResultat(i) & "mille "
        End If
        i = i + 1
    End If
    If e > 0 Then 'les unités
        strTemp = strTemp & strResultat(i)
    Else 'pas de donnée
        strTemp = "Zéro"
    End If
    LesMilliers = strTemp
End Function

Private Function Centaine(Nombre As String) As String
Dim i As Integer, e(3) As Integer, a As String
Dim strBuff As String
    For i = 3 To 1 Step -1
        e(i) = Val(Mid(Nombre, i, 1))
    Next i
    e(0) = Val(Right(Nombre, 2))
    
    If e(3) = 1 Then strBuff = "et un " Else strBuff = Unite(e(3))
    
    If e(0) < 20 Then
        strBuff = Unite(e(0))
    ElseIf e(0) < 70 Or (e(0) > 79 And e(0) < 90) Or pays <> 0 Then
        strBuff = Dixaines(e(2)) & strBuff
    Else
        If e(0) > 89 Then i = 80 Else i = 60
        strBuff = Dixaines(e(2) - 1) & Unite(e(0) - i)
    End If
    
    'Centaine
    If e(1) = 1 Then
        strBuff = "Cent " & strBuff
    ElseIf e(1) >= 1 Then
        If e(0) = 0 Then a = "cents " Else a = "cent "
        strBuff = Unite(e(1)) & a & strBuff
    End If
    Centaine = strBuff
End Function
Meilleures réponses pour « VB6/VBA Transformer nombre en texte » dans :
[VB6/VBA] Le contrôle CommonDialog. VoirLes différentes fonctions du contrôle CommonDialog J'ai laissé toutes les constantes disponibles bien qu'elles ne sont pas toutes utilisées dans les fonctions proposées, elles permettront d'éventuelles recherches sur d'autres données...
Télécharger Greek textbox VoirSi vous êtes un adepte de la langue grecque et que vous en avez marre d'utiliser le " greeklish" c'est à dire l'utilisation l'alphabet latin pour écrire des mots en grec. Greeklish converter est une extension Firefox qui vous convertire rapidement...