تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
تحويل الارقام الى حروف Convertir des chiffres en lettres
#1
الادوات المطلوبة :
- 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
{وَسَارِعُواْ إِلَى مَغْفِرَةٍ مِّن رَّبِّكُمْ وَجَنَّةٍ عَرْضُهَا السَّمَاوَاتُ وَالأَرْضُ أُعِدَّتْ لِلْمُتَّقِينَ }آل عمران133
الرد }}}}
تم الشكر بواسطة:
#2
لو تفضل الأخ الكريم لم أفهم ما الغرض من المشروع بالضبط فلقد قمت بنسخ الأكواد وعمل رن للمشروع ولكني لم استوعب النتيجة أرجو التوضيح أكثر
الرد }}}}
تم الشكر بواسطة:
#3
هذا المشروع يقوم باستبدال الارقام مثلا [SIZE=7]3 الى كلمات trois[/SIZE]
{وَسَارِعُواْ إِلَى مَغْفِرَةٍ مِّن رَّبِّكُمْ وَجَنَّةٍ عَرْضُهَا السَّمَاوَاتُ وَالأَرْضُ أُعِدَّتْ لِلْمُتَّقِينَ }آل عمران133
الرد }}}}
تم الشكر بواسطة:
#4
اخي انا لصراحة اكره انسخ الاكواد و الصقها بدون ما افهم شي طبعا هون صعب الشرح بس ياريت حد يعلمني انتو كيف كتبتو هاي الاكواد كلها
لو كان للضمير العربي (واتس اب)Huh
لكان اخر ظهور له منذ زماان بعيدConfused
الرد }}}}
تم الشكر بواسطة:
#5
PHP كود :
Public Function Horof(X
      
Ma " ريال" 
      
Mi " هللة" 
      
Int(X
      
Val(Right(Format(X"000000000000.00"), 2)) 
      
SHorof(N
      If 
<> "" And 0 Then Result Ma " و " Mi 
      
If <> "" And 0 Then Result Ma 
      
If "" And <> 0 Then Result Mi 
      Horof 
Result 
       
End 
Function 

Private Function 
SHorof(X
       
      
Int(X
      
Format(N"000000000000"
      
C1 Val(Mid(C121)) 
      
Select Case C1 
            
Case Is 1Letter1 "واحد" 
            
Case Is 2Letter1 "اثنان" 
            
Case Is 3Letter1 "ثلاثة" 
            
Case Is 4Letter1 "اربعة" 
            
Case Is 5Letter1 "خمسة" 
            
Case Is 6Letter1 "ستة" 
            
Case Is 7Letter1 "سبعة" 
            
Case Is 8Letter1 "ثمانية" 
            
Case Is 9Letter1 "تسعة" 
      
End Select 
       
      C2 
Val(Mid(C111)) 
      
Select Case C2 
            
Case Is 1Letter2 "عشر" 
            
Case Is 2Letter2 "عشرون" 
            
Case Is 3Letter2 "ثلاثون" 
            
Case Is 4Letter2 "اربعون" 
            
Case Is 5Letter2 "خمسون" 
            
Case Is 6Letter2 "ستون" 
            
Case Is 7Letter2 "سبعون" 
            
Case Is 8Letter2 "ثمانون" 
            
Case Is 9Letter2 "تسعون" 
      
End Select 
       
      
If Letter1 <> "" And C2 1 Then Letter2 Letter1 " و" Letter2 
      
If Letter2 "" Then Letter2 Letter1 
      
If C1 And C2 1 Then Letter2 Letter2 "ة" 
      
If C1 And C2 1 Then Letter2 "احدى عشر" 
      
If C1 And C2 1 Then Letter2 "اثنى عشر" 
      
If C1 And C2 1 Then Letter2 Letter1 " " Letter2 
      C3 
Val(Mid(C101)) 
      
Select Case C3 
            
Case Is 1Letter3 "مائة" 
            
Case Is 2Letter3 "مئتان" 
            
Case Is 2Letter3 Left(SHorof(C3), Len(SHorof(C3)) - 1) + "مائة" 
      
End Select 
      
If Letter3 <> "" And Letter2 <> "" Then Letter3 Letter3 " و" Letter2 
      
If Letter3 "" Then Letter3 Letter2 
       
      C4 
Val(Mid(C73)) 
      
Select Case C4 
            
Case Is 1Letter4 "الف" 
            
Case Is 2Letter4 "الفان" 
            
Case 3 To 10Letter4 SHorof(C4) + " آلاف" 
            
Case Is 10Letter4 SHorof(C4) + " الف" 
      
End Select 
      
If Letter4 <> "" And Letter3 <> "" Then Letter4 Letter4 " و" Letter3 
      
If Letter4 "" Then Letter4 Letter3 
      C5 
Val(Mid(C43)) 
      
Select Case C5 
            
Case Is 1Letter5 "مليون" 
            
Case Is 2Letter5 "مليونان" 
            
Case 3 To 10Letter5 SHorof(C5) + " ملايين" 
            
Case Is 10Letter5 SHorof(C5) + " مليون" 
      
End Select 
      
If Letter5 <> "" And Letter4 <> "" Then Letter5 Letter5 " و" Letter4 
      
If Letter5 "" Then Letter5 Letter4 
       
      C6 
Val(Mid(C13)) 
      
Select Case C6 
            
Case Is 1Letter6 "مليار" 
            
Case Is 2Letter6 "ملياران" 
            
Case Is 2Letter6 SHorof(C6) + " مليار" 
      
End Select 
      
If Letter6 <> "" And Letter5 <> "" Then Letter6 Letter6 " و" Letter5 
      
If Letter6 "" Then Letter6 Letter5 
      SHorof 
Letter6 
       
End 
Function 


وهذا كود بحث باكثر من طريقة والجمع بالارقام واظهارها بالحروف بجانب الارقام (( عبر label وعددهم 11 label))


PHP كود :
Private Sub Command1_Click() 

Dim b   As String 
" هذا أجمالي السحب لجميع الموظفين " 
Select Case Combo1.ListIndex 
Case 
Adodc1
.RecordSource "select *from stor where no_job=" Val(Text1.Text
Adodc1.Refresh 
Adodc2
.RecordSource "select sum(op),sum(do),sum(cheke),sum(teeth),sum(eye),sum(bayby),sum(ded),sum(out),sum(help),sum(hurt),sum(totel) from stor where no_job=" Val(Text1.Text
Adodc2.Refresh 
If Val(Text3.Text) Or Val(Text4.Text) Or Val(Text5.Text) Or Val(Text6.Text) Or Val(Text7.Text) Or Val(Text8.Text) Or Val(Text9.Text) Or Val(Text10.Text) Or Val(Text11.Text) > 0 Then 

S1 
Horof(Text3.Text
S2 Horof(Text2.Text
S3 Horof(Text7.Text
S4 Horof(Text8.Text
S5 Horof(Text9.Text
S6 Horof(Text10.Text
S7 Horof(Text13.Text
S8 Horof(Text11.Text
S9 Horof(Text4.Text
S10 Horof(Text5.Text
S11 Horof(Text6.Text
Else 
S1.Caption "صفر ريال" 
S2.Caption "صفر ريال" 
S3.Caption "صفر ريال" 
S4.Caption "صفر ريال" 
S5.Caption "صفر ريال" 
S6.Caption "صفر ريال" 
S7.Caption "صفر ريال" 
S8.Caption "صفر ريال" 
S9.Caption "صفر ريال" 
S10.Caption "صفر ريال" 
S11.Caption "صفر ريال" 

End If 

Case 

Adodc1
.RecordSource "select *from stor where name=  '" Text1.Text "'" 
Adodc1.Refresh 
Adodc2
.RecordSource "select sum(op),sum(do),sum(cheke),sum(teeth),sum(eye),sum(bayby),sum(ded),sum(out),sum(help),sum(hurt),sum(totel) from stor where name=  '" Text1.Text "'" 
Adodc2.Refresh 
If Val(Text3.Text) Or Val(Text4.Text) Or Val(Text5.Text) Or Val(Text6.Text) Or Val(Text7.Text) Or Val(Text8.Text) Or Val(Text9.Text) Or Val(Text10.Text) Or Val(Text11.Text) > 0 Then 

S1 
Horof(Text3.Text
S2 Horof(Text2.Text
S3 Horof(Text7.Text
S4 Horof(Text8.Text
S5 Horof(Text9.Text
S6 Horof(Text10.Text
S7 Horof(Text13.Text
S8 Horof(Text11.Text
S9 Horof(Text4.Text
S10 Horof(Text5.Text
S11 Horof(Text6.Text
Else 
S1.Caption "صفر ريال" 
S2.Caption "صفر ريال" 
S3.Caption "صفر ريال" 
S4.Caption "صفر ريال" 
S5.Caption "صفر ريال" 
S6.Caption "صفر ريال" 
S7.Caption "صفر ريال" 
S8.Caption "صفر ريال" 
S9.Caption "صفر ريال" 
S10.Caption "صفر ريال" 
S11.Caption "صفر ريال" 

End If 
Case 

Adodc1
.RecordSource "select *from stor where no_bil=" Val(Text1.Text
Adodc1.Refresh 
Adodc2
.RecordSource "select sum(op),sum(do),sum(cheke),sum(teeth),sum(eye),sum(bayby),sum(ded),sum(out),sum(help),sum(hurt),sum(totel) from stor where no_bil=" Val(Text1.Text
Adodc2.Refresh 
If Val(Text3.Text) Or Val(Text4.Text) Or Val(Text5.Text) Or Val(Text6.Text) Or Val(Text7.Text) Or Val(Text8.Text) Or Val(Text9.Text) Or Val(Text10.Text) Or Val(Text11.Text) > 0 Then 

S1 
Horof(Text3.Text
S2 Horof(Text2.Text
S3 Horof(Text7.Text
S4 Horof(Text8.Text
S5 Horof(Text9.Text
S6 Horof(Text10.Text
S7 Horof(Text13.Text
S8 Horof(Text11.Text
S9 Horof(Text4.Text
S10 Horof(Text5.Text
S11 Horof(Text6.Text
Else 
S1.Caption "صفر ريال" 
S2.Caption "صفر ريال" 
S3.Caption "صفر ريال" 
S4.Caption "صفر ريال" 
S5.Caption "صفر ريال" 
S6.Caption "صفر ريال" 
S7.Caption "صفر ريال" 
S8.Caption "صفر ريال" 
S9.Caption "صفر ريال" 
S10.Caption "صفر ريال" 
S11.Caption "صفر ريال" 

End If 
Case 

Adodc1
.RecordSource "select *from stor where on_Card=" Val(Text1.Text
Adodc1.Refresh 
Adodc2
.RecordSource "select sum(op),sum(do),sum(cheke),sum(teeth),sum(eye),sum(bayby),sum(ded),sum(out),sum(help),sum(hurt),sum(totel) from stor where on_Card=" Val(Text1.Text
Adodc2.Refresh 
Text14
.Text Text14.Text Text1.Text 
If Val(Text3.Text) Or Val(Text4.Text) Or Val(Text5.Text) Or Val(Text6.Text) Or Val(Text7.Text) Or Val(Text8.Text) Or Val(Text9.Text) Or Val(Text10.Text) Or Val(Text11.Text) > 0 Then 

S1 
Horof(Text3.Text
S2 Horof(Text2.Text
S3 Horof(Text7.Text
S4 Horof(Text8.Text
S5 Horof(Text9.Text
S6 Horof(Text10.Text
S7 Horof(Text13.Text
S8 Horof(Text11.Text
S9 Horof(Text4.Text
S10 Horof(Text5.Text
S11 Horof(Text6.Text
Else 
S1.Caption "صفر ريال" 
S2.Caption "صفر ريال" 
S3.Caption "صفر ريال" 
S4.Caption "صفر ريال" 
S5.Caption "صفر ريال" 
S6.Caption "صفر ريال" 
S7.Caption "صفر ريال" 
S8.Caption "صفر ريال" 
S9.Caption "صفر ريال" 
S10.Caption "صفر ريال" 
S11.Caption "صفر ريال" 

End If 
Case 


Adodc1
.RecordSource "select *from stor;" 
Adodc1.Refresh 
Adodc2
.RecordSource "select sum(op),sum(do),sum(cheke),sum(teeth),sum(eye),sum(bayby),sum(ded),sum(out),sum(help),sum(hurt),sum(totel) from stor;" 
Adodc2.Refresh 
Text14
.Text 
If Val(Text3.Text) Or Val(Text4.Text) Or Val(Text5.Text) Or Val(Text6.Text) Or Val(Text7.Text) Or Val(Text8.Text) Or Val(Text9.Text) Or Val(Text10.Text) Or Val(Text11.Text) > 0 Then 

S1 
Horof(Text3.Text
S2 Horof(Text2.Text
S3 Horof(Text7.Text
S4 Horof(Text8.Text
S5 Horof(Text9.Text
S6 Horof(Text10.Text
S7 Horof(Text13.Text
S8 Horof(Text11.Text
S9 Horof(Text4.Text
S10 Horof(Text5.Text
S11 Horof(Text6.Text
Else 
S1.Caption "صفر ريال" 
S2.Caption "صفر ريال" 
S3.Caption "صفر ريال" 
S4.Caption "صفر ريال" 
S5.Caption "صفر ريال" 
S6.Caption "صفر ريال" 
S7.Caption "صفر ريال" 
S8.Caption "صفر ريال" 
S9.Caption "صفر ريال" 
S10.Caption "صفر ريال" 
S11.Caption "صفر ريال" 

End If 

End Select 

End Sub 

ان شاء الله تستفيد منه
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [سؤال] المساعدة في تقريب الارقام عمور2016 3 110 19-11-16, 12:08 PM
آخر رد: عمور2016
  ارجو المساعدة في تحويل اكواد bidaya 7 119 19-11-16, 04:27 AM
آخر رد: ابو ليلى
  [سؤال] سوال؟ تحويل صورة الى ايقونة للبرنامج amer2000 6 115 21-10-16, 03:56 AM
آخر رد: أبو عمر
  كود تحويل من الارقام الى الاحرف الابجديه الحلوانى 1 58 21-10-16, 01:00 AM
آخر رد: Ahmed_Mansoor
  [vb6.0] سؤال حول اتجاه الارقام التصاعدية chaabane 4 149 07-06-16, 06:32 PM
آخر رد: chaabane
  [سؤال] ماهو كود كتابة الحقل حروف عربية فقط alfakeeh 5 311 31-03-16, 09:26 PM
آخر رد: ahmed.m
  تحويل flv إلى mp3 faridfarid 1 379 01-03-15, 04:36 AM
آخر رد: InJuries
  [سؤال] تحويل الصوت الى نص داخل textbox maro 1 1,079 07-01-15, 11:30 AM
آخر رد: برير مسبل
  [vb6.0] طلب تحويل برنامج exe habbeb 2 610 27-12-14, 12:25 PM
آخر رد: habbeb
  مشكلة فى اظهار الارقام بما يمثلها من اسماء هيثم مازن 0 339 05-06-14, 01:44 PM
آخر رد: هيثم مازن

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم