mada4top قام بنشر يوليو 7, 2014 قام بنشر يوليو 7, 2014 السلام عليكم اولا احب اشكر جميع القائمين علي هذا المنتدي الاكثر من رائع وانا شخصيا تعلمت منكم الكثير وايضا بشكر كل الاعضاء المشاركين الحقيقة كان عندي كود التفقيط لكن فيه غلط بسيط كده وحاولت اعدله لكن للاسف ومابقاش بيستغل اصلا انا محتاج كود التفقيط باللغة العربية بالريال ولو امكن يكون بالإنجليزية كمان 1
خزاني قام بنشر يوليو 7, 2014 قام بنشر يوليو 7, 2014 السلام عليكم تغـيـيـر ديـنار بــــــــــــــــــــــ: ريـال وضع هذا فى الخلبة (NbLettresArabes(H6= ' --------------------------------------------- ' FONCTION DE TRADUCTION D'UNE SOMME EN LETTRES ' --------------------------------------------- Option Explicit Option Base 1 Public Unité As Variant Public Dizaine As Variant Public Décimales As Currency Public CasPart As Variant Public Lettres As String Public Cent_Pluriel As Boolean ' ------------------- ' FONCTION PRINCIPALE ' ------------------- ' Function NbLettresArabes(Nombre As Currency) As String ' Limitation à 999 999 999 999 . 99 If Nombre >= 1000000000000# Then MsgBox "! هاذ العدد كبير", 0, "Message" Exit Function End If ' Initialisation des tableaux Unité = Array("واحد", "اثنان", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية ", "تسعة") Dizaine = Array("عشرة", "عشرون", "ثلاثون", "اربعون", "خمسون", "ستون", "سبعون", "ثمانون", "تسعون") CasPart = Array("عشرة", "احد عشرة", "اثن عشرة", "ثلاثة عشرة", "أربعة عشرة", "خمسةعشرة", "ستةعشرة", "سبعةعشرة", "ثمانية عشرة", "تسعة عشرة") ' Mise à vide de la chaîne de réception de la traduction du nombre Lettres = "" ' Initialisation des indicateurs de pluriel des nombres cent et vingt Cent_Pluriel = True ' Conversion de la partie décimale en un nombre de 0 à 99 ' arrondi à l'unité la plus proche Décimales = CInt((Nombre - Fix(Nombre)) * 100) ' Conservation de la partie entière du nombre Nombre = Fix(Nombre) ' Orientation du traitement suivant valeur de la partie entière Select Case Nombre Case 0 Lettres = "صفر" 'Zéro Case 1 To 9 Lettres = Unité(CInt(Nombre)) Case 10 To 99 Trt_Dizaines Nombre Case 100 To 999 Trt_Centaines Nombre Case 1000 To 999999999999# Trt_Multiples_de_Mille Nombre End Select ' Indication de la monnaie If Décimales > 0 Then Lettres = Lettres & " دينار " + " و " Else If Décimales = 0 Then Lettres = Lettres & " دينار " ' + " و " End If End If ' Orientation du traitement suivant valeur de la partie décimale Select Case Décimales Case 1 To 9 Lettres = Lettres & Unité(CInt(Décimales)) Case 10 To 99 Trt_Dizaines Décimales End Select ' Indication des centimes Select Case Décimales Case 1 Lettres = Lettres & " سنتيم" ' Centimes'" و" + Case Is > 1 Lettres = Lettres & " سنتيم" ' Centimes Case Is < 1 Lettres = Lettres ' & " سنتيم" ' Centimes End Select ' Renvoi du nombre traduit en lettres If Lettres = "صفر" & " دينار " Then Lettres = "" Else NbLettresArabes = Lettres End If End Function ' -------------------------------- ' TRAITEMENT DES MULTIPLES DE 1000 ' -------------------------------- Sub Trt_Multiples_de_Mille(Nombre As Currency) Dim Rank As Currency Dim Nom_Rang As String Dim Reste As Currency Cent_Pluriel = False ' Initialisation suivant taille du nombre : milliers, millions ou milliards Select Case Nombre Case 1000 To 999999 Rank = Fix(Nombre / 1000) Reste = Nombre Mod 1000 Nom_Rang = "ألف" ' Mille Case 1000000 To 999999999 Rank = Fix(Nombre / 1000000) Reste = Nombre Mod 1000000 If Rank > 1 Then Nom_Rang = "مليون" 'Millions Else Nom_Rang = "مليون" ' Million End If Case Is > 999999999 Rank = Fix(Nombre / 1000000000) Reste = Nombre - Rank * 1000000000 If Rank > 1 Then Nom_Rang = "ميليار" ' Milliard Else Nom_Rang = "ميليار" ' Milliard End If End Select ' Traitement du rang des milliers, millions ou milliards Select Case Rank Case 1 If Nom_Rang = "الف" Then Lettres = Lettres & "آلاف" Else Lettres = Lettres & Unité(CInt(Rank)) & " " & Nom_Rang '& " و" End If Case 2 Lettres = Lettres & Unité(CInt(Rank)) & " " & Nom_Rang '& " و" Case 3 To 9 Lettres = Lettres & Unité(CInt(Rank)) & " " & Nom_Rang '& " و" Case 10 To 99 Trt_Dizaines (Rank) Lettres = Lettres & " " & Nom_Rang '& " و" Case 100 To 999 Trt_Centaines Rank Lettres = Lettres & " " & Nom_Rang '& " و" End Select Cent_Pluriel = True ' Orientation du traitement du reste si > 0 Select Case Reste Case 1 To 9 Lettres = Lettres & " و" & " " & Unité(CInt(Reste)) Case 10 To 99 Lettres = Lettres & " و" & " " Trt_Dizaines Reste Case 100 To 999 Lettres = Lettres & " و" & " " Trt_Centaines Reste Case Is > 999 Lettres = Lettres & " و" & " " Trt_Multiples_de_Mille Reste Case Else Lettres = Lettres & " " End Select Lettres = Lettres End Sub ' ----------------------------------- ' TRAITEMENT DES NOMBRES DE 100 0 999 ' ----------------------------------- Sub Trt_Centaines(Nombre As Currency) Dim Rank As Currency Dim Reste As Currency Rank = Fix(Nombre / 100) Reste = Nombre Mod 100 ' Traitement du rang des centaines If Rank = 1 Then If Reste = 0 Then Lettres = Lettres & "مائة" '& " و" Else Lettres = Lettres & "مائة" & " و" End If Else If Reste = 0 And Cent_Pluriel Then Lettres = Lettres & Unité(CInt(Rank)) & " " & "مئات" Else Lettres = Lettres & Unité(CInt(Rank)) & " " & "مئات" & " و" End If End If ' Traitement du reste < 100 Select Case Reste Case 1 To 9 Lettres = Lettres & " " & Unité(CInt(Reste)) Case Is > 9 Lettres = Lettres & " " Trt_Dizaines (Reste) End Select End Sub ' --------------------------------- ' TRAITEMENT DES NOMBRES DE 10 0 99 ' --------------------------------- Sub Trt_Dizaines(Nombre As Currency) Dim Reste As Integer Dim Rank As Integer Rank = Fix(Nombre / 10) Reste = Nombre Mod 10 Select Case Rank Case 1 Lettres = Lettres & CasPart(Reste + 1) Case 7 Select Case Reste Case 0 ' Nombre 70 Lettres = Lettres & Dizaine(Rank) Case Else ' Nombre 71 à 76 Lettres = Lettres & Unité(CInt(Reste)) & " و " & Dizaine(Rank) End Select Case 8 If Reste = 0 Then ' Nombre 80 Lettres = Lettres & Dizaine(Rank) Else ' Nombres 81 à 89 Lettres = Lettres & Unité(CInt(Reste)) & " و " & Dizaine(Rank) End If Case 9 If Reste = 0 Then ' Nombres 90 Lettres = Lettres & Dizaine(Rank) Else ' Nombres 91 à 99 Lettres = Lettres & Unité(CInt(Reste)) & " و " & Dizaine(Rank) End If Case Else ' Nombres 20 à 69 Select Case Reste Case 0 ' Nombres 20, 30, 40, 50, 60 Lettres = Lettres & Dizaine(Rank) Case Else ' Autres nombres Lettres = Lettres & Unité(CInt(Reste)) & " و " & Dizaine(Rank) End Select End Select End Sub 2
أم عبد الله قام بنشر يوليو 8, 2014 قام بنشر يوليو 8, 2014 الأستاذ /mada4top السلام عليكم ورحمة الله وبركاته بعد إذن الأستاذ / خزاني جزاه الله خيراً على الكود وإليك الملف به تفيط عربي وانجليزي . تفقيط بالريال.rar تفقيط انجليزي.rar 1 1
mada4top قام بنشر يوليو 9, 2014 الكاتب قام بنشر يوليو 9, 2014 اخي خزاني بارك الله فيك وجزاك الله خيرا
mada4top قام بنشر يوليو 9, 2014 الكاتب قام بنشر يوليو 9, 2014 ام عبدالله متشكرا جدا لاهتمام حضرتك ملفات رائعة
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.