الرئيسية
المزاج
افتح صفحة الاكسال واضغط على الخانة التي ترغب التحويل اليها
بعد ذلك توجه لقائمة ادوات واضغط على ماكرو ثم على محرر الفيزيال بازيك فتظهر لك صفحة جديدة فارغة للمحرر
ثم اختار usert userfrom هي بالقرب من مفتاح الحفظ لليسار تماما فتظهر لك 03 خيارات اختارmodule فتظهر لك نافذة فارغة بيضاء قم بنسخ هذه الدالة ولصقها في الفراغ الدالة هي:Function lireCentaine(ByVal Montant As Double) As String
Dim ChiffreLettre
Dim Centaine As Double
Dim Dizaine As Double
Dim T As String
Dim Chaine As String
ChiffreLettre = Array("un", "deux", "trois", "quatre", "cinq", "six", _
"sept", "huit", "neuf", "dix", _
"onze", "douze", "treize", "quatorze", "quinze", _
"seize", "dix-sept", "dix-huit", "dix-neuf")
Centaine = Int(Montant / 100)
Select Case Centaine
Case 0
Chaine = ""
Case 1
Chaine = "cent"
Case Else
Chaine = ChiffreLettre(Centaine - 1) & " cent"
End Select
Dizaine = Modulo(Montant, 100)
Select Case Dizaine
Case 0
T = ""
Case 1 To 19
T = ChiffreLettre(Dizaine - 1)
Case 20
T = "vingt"
Case 21
T = "vingt et un"
Case 22 To 29
T = "vingt " & ChiffreLettre(Dizaine - 21)
Case 30
T = "trente"
Case 31
T = "trente et un"
Case 32 To 39
T = "trente " & ChiffreLettre(Dizaine - 31)
Case 40
T = "quarante"
Case 41
T = "quarante et un"
Case 42 To 49
T = "quarante " & ChiffreLettre(Dizaine - 41)
Case 50
T = "cinquante"
Case 51
T = "cinquante et un"
Case 52 To 59
T = "cinquante " & ChiffreLettre(Dizaine - 51)
Case 60
T = "soixante"
Case 61
T = "soixante et un"
Case 62 To 69
T = "soixante " & ChiffreLettre(Dizaine - 61)
Case 70
T = "soixante-dix"
Case 71
T = "soixante et onze"
Case 72 To 79
T = "soixante " & ChiffreLettre(Dizaine - 61)
Case 80
T = "quatre vingts"
Case 81 To 89
T = "quatre vingt " & ChiffreLettre(Dizaine - 81)
Case 90 To 99
T = "quatre vingt " & ChiffreLettre(Dizaine - 81)
Case Else
T = "Erreur de conversion !"
End Select
If (Chaine & " " & T) = " " Then
lireCentaine = ""
Else
lireCentaine = LTrim(Chaine & " ") & T
End If
End Function
Function Modulo(ByVal Nombre As Double, ByVal Diviseur As Double) As Double
Modulo = Nombre - (Diviseur * Int(Nombre / Diviseur))
End Function
Function Arrondir(ByVal ValeurArrondi As Double, ByVal NbreDeci As Integer) As Double
Arrondir = ValeurArrondi + (5 * 10 ^ -(NbreDeci + 1))
Arrondir = Int(Arrondir * 10 ^ NbreDeci) / 10 ^ NbreDeci
End Function
Function NombreToFrancais(ByVal Total As Double) As String
Dim Millions As Double
Dim Milliers As Double
Dim cent As Double
Dim decimales As Double
Dim T0 As String
Dim T1 As String
Dim T2 As String
Dim T3 As String
Dim Resultat As String
Dim T As String
Dim S1, S2 As String
Total = Arrondir(Total, 2)
Millions = Int(Modulo(Int(Total / 1000000), 1000))
Milliers = Int(Modulo(Int(Total / 1000), 1000))
cent = Int(Modulo(Total, 1000))
decimales = Arrondir((Modulo(Total * 100, 100)), 0)
S1 = ""
S2 = ""
If Milliers <= 1 Then S1 = "" Else S1 = "s"
If cent <= 1 Then
If Milliers < 1 Then
If Millions < 1 Then
S1 = ""
Else
S1 = "s"
End If
Else
S1 = "s"
End If
Else
S1 = "s"
End If
If decimales <= 1 Then S2 = "" Else S2 = "s"
If Total <= 1 Then S1 = "" Else S1 = "s"
T0 = lireCentaine(Millions)
T1 = lireCentaine(Milliers)
T2 = lireCentaine(cent)
T3 = lireCentaine(decimales)
If (T0 = "" And T1 = "" And T3 = "" And Right(T2, 5) = "cent ") Then
If cent > 100 Then T2 = RTrim(T2) & "s"
End If
If T0 <> "" Then
If (T1 <> "") Then
If (T2 <> "") Then
T0 = T0
T1 = " et " & T1
T2 = " et " & T2
End If
End If
End If
If T0 = "" Then
If (T1 <> "") Then
If (T2 <> "") Then
T0 = T0
T1 = T1
T2 = " et " & T2
End If
End If
End If
If T0 <> "" Then
If (T1 <> "") Then
If (T2 = "") Then
T0 = T0
T1 = " et " & T1
T2 = T2
End If
End If
End If
If T0 = "" Then
If (T1 <> "") Then
If (T2 = "") Then
T0 = T0
T1 = T1
T2 = T2
End If
End If
End If
If T0 <> "" Then
If (T2 <> "") Then
If (T1 = "") Then
T0 = T0
T2 = " et " & T2
T1 = T1
End If
End If
End If
If T0 = "" Then
If (T2 <> "") Then
If (T1 = "") Then
T0 = T0
T1 = T1
T2 = T2
End If
End If
End If
If T0 <> "" Then
Resultat = T0 & " million "
If T1 = "" And T2 = "" And T3 = "" Then
Resultat = T0 & " million de"
End If
Else
Resultat = ""
End If
If T1 <> "" Then
If T1 = "un" Then
T1 = ""
End If
Resultat = Resultat & T1 & " mille "
Else
Resultat = Resultat & ""
End If
If T2 <> "" Then
Resultat = Resultat & T2 & " DA"
Else
If Resultat <> "" Then
Resultat = Resultat & " DA"
End If
End If
If T3 <> "" Then
If Resultat <> "" Then
Resultat = Resultat & " et " & decimales & " Centimes"
Else
Resultat = decimales & " Centimes"
End If
End If
NombreToFrancais = Resultat
End Function
بعد ذلك اضغط على run sub وهو عبارة عن نافذة صغيرة على شكل مثلث لتظهر لك نافذة macros name قم يتسميتها اي اسم ثم احفظ العملية لك الخيار في جعلها تطبق على هذا المف او على كل ملفات الاكسال في السطر الاخير من نافذة الحفظ
ثم اغلق صفحة محرر الباسيك وعد لصفحة الاكسال ثم اضغط على الخانة التي ترغب في وضع وكتابة الحروف بها ثم اضغط على قائمة ادارج ثم دالة وابحث عن اسم الدالة وهو NombreToFrancais ثم اضغط على الرقم المراد تحويله لحروف وسوف يقوم الاكسال تلقائيا بتحويل الرقام لحروف في كل مرة تغير فيها الرقم
وبالتوفيق لاتنسوا الدعاء بالخير
