10:52 AM |الساعة الآن   
 
العودة ملتقى الموظف الجزائرى  :: 

منتدى ادارة الجماعات الاقليمية

 :: 

الميزانية المحلية






أهلا وسهلا بك إلى ملتقى الموظف الجزائرى.
أهلا وسهلا بك زائرنا الكريم، إذا كانت هذه زيارتك الأولى للمنتدى، فيرجى التكرم بزيارة صفحة التعليمـــات، بالضغط هنا.كما يشرفنا أن تقوم بالتسجيل بالضغط هنا إذا رغبت بالمشاركة في المنتدى، أما إذا رغبت بقراءة المواضيع والإطلاع فتفضل بزيارة القسم الذي ترغب أدناه.

الرئيسيةالبوابةبحـثس .و .جدخولالتسجيل
اعلان هام للمسجلين الجدد :بمجرد التسجيل يتم إرسال كود التفعيل إلى حسابك .. أي الإيميل الذي وضعته عند التسجيل بالمنتدى ... إذهب إلى علبة البريد فإذا لم تجده في الرسائل الواردة حاول أن تبحث عنه في صندوق بريد الغير مرغوب فيه SPAM



لمن يرغب في تحويل الارقام لحروف بالفرنسية


شاطر
 #1  
السبت 12 مارس 2011, 15:17
 
 
 
ذكر
الاقامة : algerie
المشاركات : 159
نقاط : 242
تاريخ التسجيل : 23/01/2011
العمر : 41
العمل : adminisrateur
المزاج المزاج : مرح وبشوش دائما
افتراضيلمن يرغب في تحويل الارقام لحروف بالفرنسية

الافيس يجب ان يكون 2003
افتح صفحة الاكسال واضغط على الخانة التي ترغب التحويل اليها
بعد ذلك توجه لقائمة ادوات واضغط على ماكرو ثم على محرر الفيزيال بازيك فتظهر لك صفحة جديدة فارغة للمحرر
ثم اختار 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 ثم اضغط على الرقم المراد تحويله لحروف وسوف يقوم الاكسال تلقائيا بتحويل الرقام لحروف في كل مرة تغير فيها الرقم
وبالتوفيق لاتنسوا الدعاء بالخير


 #2  
الإثنين 04 أبريل 2011, 20:23
 
 
 
ذكر
الاقامة : سطيف
المشاركات : 14
نقاط : 14
تاريخ التسجيل : 02/04/2011
العمل : مفتش رئيسي
افتراضيرد: لمن يرغب في تحويل الارقام لحروف بالفرنسية

لمادا كل هذه الدالة يتوفر لدي ماكرو يمكنه تحويل الأرقام إلى أحرف بثلاثة لغاة :عربية فرنسية إنجليزية لكن لم أجد الطريقة لوضعه في الموقع وللبحث عليه يسمى :boussaid.xla سأعلمكم بطريقة عمله :أكتب الصيغة التالية : = (fr(a3 أو = (ar(a3 أو = (eng(a3


 #3  
الأحد 09 ديسمبر 2012, 17:00
 
 
 
انثى
الاقامة : laghouat
المشاركات : 2
نقاط : 2
تاريخ التسجيل : 09/12/2012
العمل : architecte
افتراضيرد: لمن يرغب في تحويل الارقام لحروف بالفرنسية

السلام عليكم شكرا جزيلا على المجهود لكن عندي مشكل كل مرة اصل الى المرحلة الاخيرة اي مرحلة التسمية يقلي الاسم خاطئ ارجو ان تساعدني او ان توضح اكثر
بارك الله فيك






 
الإشارات المرجعية


  
وما من كاتب إلا سيفنى . ويبقي الدهر ما كتبت يداه



تعليمات المشاركة
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى

BB code is متاحة
كود [IMG] متاحة
كود HTML متاحة