[derbaliammar]

الادوات المطلوبة :
- text1 نسميه TxtNombre
- label 1 نسميها LblConverti
- commande نسميه CmdConvertir
- commande نسميه CmdFin
- commande نسميه CmdNewConv
- فورمة واحدة
- Module
- class Module

اذا ننطلق في البرمجة ضع هذا الكود في الفورمة التي نسميها FrmPrincipale :

كود :

Option Explicit

Dim ClsConvertir As ClsChiffresEnLettres

Private Sub CmdConvertir_Click()

    ' instanciation de la classe dans laquelle se trouve la fonction de conversion
    Set ClsConvertir = New ClsChiffresEnLettres
    
    Dim Nombre As Variant
    
    Nombre = TxtNombre.Text
    
    ' appel de la classe en donnant le nombre à convertir
    ClsConvertir.NombreChiffres = Nombre
    ' puis appel pour convertir réellement ce nombre
    LblConverti.Caption = ClsConvertir.Conversion(Nombre)
    
    CmdNewConv.Visible = True
    
End Sub

Private Sub CmdFin_Click()

    Unload Me
    End
    
End Sub

Private Sub CmdNewConv_Click()

    LblConverti.Caption = ""
    TxtNombre.Text = ""
    TxtNombre.SetFocus
    CmdNewConv.Visible = False
    
End Sub

Private Sub Form_Load()

    ImgFond.Picture = LoadPicture(App.Path & "\confetti.jpg")
    
    TxtNombre.Text = ""
    
End Sub

Private Sub Form_Resize()

    ImgFond.Move 0, 0, ScaleWidth, ScaleHeight
    
End Sub

Private Sub TxtNombre_KeyPress(KeyAscii As Integer)
          
    Select Case KeyAscii
        Case Asc(".") ' change le "." en ","
            KeyAscii = Asc(",")
  
        Case 8 ' gère le backspace
            TxtNombre = Left(TxtNombre, Len(TxtNombre))
            
        Case 48 To 57, Asc(",") ' accepte si c'est un chiffre correct
  
        Case Else 'n'inscrit rien si c'est un caractère incorrect
            KeyAscii = 0
            
    End Select
    
End Sub

[SIZE=5]نظيف [/SIZE]Module و نسمه ModuleChLet و نظيف له الكود التالي

كود :

Option Explicit

' j'ai pris le principe du fichier ini pour lire dans un fichier la traduction en lettre des chiffres
' il suffit donc de changer ce fichier pour avoir les chiffres dans une autre langue
' et aussi d'adapter un peu la routines (par ex pour les français : 70 = soixante-dix)
Public CheminFichierLettres As String


Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
    ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long


Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
    ByVal lpFileName As String) As Long


Public fMainForm As FrmPrincipale
Sub main()


    Set fMainForm = New FrmPrincipale
        
    CheminFichierLettres = App.Path & "\ChToLet.ini"
        
        
    fMainForm.Show
    
End Sub


Public Function EcritDansFichierLettres(Section As String, Cle As String, _
                                     Valeur As String, Fichier As String) As Long
EcritDansFichierLettres = WritePrivateProfileString(Section, Cle, Valeur, Fichier)
End Function
Public Function LitDansFichierLettres(Section As String, Cle As String, Fichier As String, _
    Optional ValeurParDefaut As String = "") As String


Dim strReturn As String
strReturn = String(255, 0)
GetPrivateProfileString Section, Cle, ValeurParDefaut, strReturn, Len(strReturn), Fichier
LitDansFichierLettres = Left(strReturn, InStr(strReturn, Chr(0)) - 1)


End Function

نظيف classmodule و نسمه ClsChiffresEnLettres و نظيف له الكود التالي

كود :

Option Explicit

'variables locales de stockage des valeurs de propriétés
Private mvarNombreChiffres As Variant 'copie locale
Private mvarNombreLettres As String 'copie locale


Public Function Conversion(ByVal nb As String) As String


    Dim NbDeci As String
    Dim Affichage As String
    Dim Entier As String
    Dim Décimal As String
    
    If InStr(nb, ",") = 0 Then           ' un entier
        Affichage = Decodage(nb)
    Else                                 ' un décimal
        Do While Right(nb, 1) = "0"      'suppression des zéros à droite de la partie décimale
            If Right(nb, 1) = "0" Then nb = Left(nb, Len(nb) - 1)
        Loop
        Entier = Decodage(Left(nb, InStr(nb, ",") - 1))
        If Right(Entier, 2) = "un" Then Entier = Entier & "e"
        If Entier = "une" Then
            Entier = Entier & " unité "
        Else
            If Entier <> "" Then
                Entier = Entier & " unités "
            End If
        End If
        Décimal = Decodage(Mid(nb, InStr(nb, ",") + 1))
        Affichage = Entier & Décimal & " "
        
        ' calcul du nombre de décimales
        NbDeci = Len(Mid(nb, InStr(nb, ",") + 1))
        Affichage = Affichage & LitDansFichierLettres("Decimale", NbDeci, CheminFichierLettres)
    
        If Décimal <> "un" Then Affichage = Affichage & "s"
    End If
    
    Conversion = Affichage
    
End Function


Public Property Let NombreLettres(ByVal vData As String)
'utilisé lors de l'affectation d'une valeur à la propriété, du coté gauche de l'affectation.
'Syntax: X.NombreLettres = 5
    mvarNombreLettres = vData
End Property




Public Property Get NombreLettres() As String
'utilisé lors de la lecture de la valeur de la propriété, du coté droit de l'instruction.
'Syntax: Debug.Print X.NombreLettres
    NombreLettres = mvarNombreLettres
End Property


Public Property Let NombreChiffres(ByVal vData As Variant)
'utilisé lors de l'affectation d'une valeur à la propriété, du coté gauche de l'affectation.
'Syntax: X.NombreChiffres = 5
    mvarNombreChiffres = vData
End Property


Public Property Get NombreChiffres() As Variant
'utilisé lors de la lecture de la valeur de la propriété, du coté droit de l'instruction.
'Syntax: Debug.Print X.NombreChiffres
    If IsObject(mvarNombreChiffres) Then
        Set NombreChiffres = mvarNombreChiffres
    Else
        NombreChiffres = mvarNombreChiffres
    End If
End Property


Private Function Decodage(ByVal nb As String) As String


    Dim nb1 As String
    
    Do While Left(nb, 1) = "0"
        If Left(nb, 1) = "0" Then nb = Mid(nb, 2) 'suppression des zéros à gauche
    Loop


    Select Case Len(nb)
        Case 0
            Decodage = ""
    
        Case 1
            Decodage = LitDansFichierLettres("Chiffres", nb, CheminFichierLettres)
        
        Case 2
            If nb < 17 Then
                Decodage = LitDansFichierLettres("Chiffres", nb, CheminFichierLettres)
            Else
                nb1 = nb - Right(nb, 1)
                Decodage = LitDansFichierLettres("Chiffres", nb1, CheminFichierLettres)
                nb1 = Right(nb, 1)
                Decodage = Decodage & "-" & LitDansFichierLettres("Chiffres", nb1, CheminFichierLettres)
            End If
            
            If Right(Decodage, 2) = "un" And nb > 20 Then Decodage = Left(Decodage, Len(Decodage) - 2) & "et un"
            If Right(Decodage, 4) = "zéro" Then Decodage = Left(Decodage, Len(Decodage) - 5)
            
        Case 3
        Select Case Left(nb, 1)
            Case "1"
                Decodage = "cent " & Decodage(Mid(nb, 2))
                
            Case Else
                Decodage = Decodage(Left(nb, 1)) & " cent " & Decodage(Mid(nb, 2))
                If Right(Decodage, 6) = " cent " Then Decodage = Left(Decodage, Len(Decodage) - 1) & "s"
        End Select
        
        Case 4 To 6
            Decodage = Decodage(Left(nb, Len(nb) - 3)) & " mille " & Decodage(Right(nb, 3))
            If Left(Decodage, 2) = "un" Then Decodage = Mid(Decodage, 4)
            
        Case 7 To 9
            Decodage = Decodage(Left(nb, Len(nb) - 6)) & " millions " & Decodage(Right(nb, 6))
            If Left(Decodage, 2) = "un" Then Decodage = Left(Decodage, 10) & Mid(Decodage, 12)
            
        Case 10 To 12
            Decodage = Decodage(Left(nb, Len(nb) - 9)) & " milliards " & Decodage(Right(nb, 9))
            If Left(Decodage, 2) = "un" Then Decodage = Left(Decodage, 11) & Mid(Decodage, 13)
                    
    End Select
End Function