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

منتدى التكنولوجيا والاعلام الالى

 :: 

الكمبيوتر والإنترنت






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

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



كود لتحويل التاريخ الى نص بالفرنسية (ارجوا المساعة في تحويله بالعربية)


شاطر
 #1  
الأربعاء 06 فبراير 2013, 21:16
 
 
 
ذكر
الاقامة : ALGERIE
المشاركات : 115
نقاط : 151
تاريخ التسجيل : 14/12/2010
العمر : 46
العمل : LOCALE
المزاج المزاج : مرح هادئ و بشوش
افتراضيكود لتحويل التاريخ الى نص بالفرنسية (ارجوا المساعة في تحويله بالعربية)

ارجو المساعدة من ذوي الاختصاص في تجويل هذا الكود ليصبح تحويل التاريخ من رقم الى نص بالعربية
اليكم الكود:

'***********************************************************************************************************
' Transforme une date en toutes lettres
' l'argument boo est utilisé pour mettre une majuscule en début de chaîne
'***********************************************************************************************************
Function DateEnLettre(dtm As Date, Optional boo As Boolean = False) As String

Dim strJour As String
Dim strMois As String
Dim strAnnée As String

If Format(dtm, "dd") = 1 Then
If boo Then
strJour = "Premier"
Else
strJour = "Premier"
End If
Else
strJour = NbVersTexte(Format(dtm, "dd"), boo)
End If
strMois = CStr(Format(dtm, "mmmm"))
strAnnée = NbVersTexte(Format(dtm, "yyyy"))
DateEnLettre = strJour & " " & strMois & " " & strAnnée
End Function

'***********************************************************************************************************
' Transforme un nombre en lettres

'***********************************************************************************************************
Public Function NbVersTexte(ValNum As Double, Optional boo As Boolean = False) As String

Static Unites() As String
Static Dixaines() As String
Static LesDixaines() As String
Static Milliers() As String

Dim I As Integer
Dim nPosition As Integer
Dim ValNb As Integer
Dim LesZeros As Integer
Dim strResultat As String
Dim strTemp As String
Dim tmpBuff As String

Unites = Split("zéro;Un;Deux;Trois;Quatre;Cinq;Six;Sept;Huit;Neuf", ";")
Dixaines = Split("Dix;Onze;Douze;Treize;Quatorze;Quinze;Seize;Dix-Sept;Dix-Huit;Dix-Neuf", ";")
LesDixaines = Split(";Dix;Vingt;Trente;Quarante;Cinquante;Soixante;Soixante-Dix;Quatre-Vingt;Quatre-Vingt-Dix", ";")
Milliers = Split(";Mil;Million;Milliard", ";")

On Error GoTo NbVersTexteError

strTemp = CStr(Int(ValNum))
'pluriel des millions
If Len(strTemp) > 6 Then
tmpBuff = Left(strTemp, Len(strTemp) - 6)
tmpBuff = Right(tmpBuff, 3)
If Val(tmpBuff) > 1 Then
Milliers(2) = Milliers(2) & "s"
End If
End If
'pluriel des milliards
If Len(strTemp) > 9 Then
tmpBuff = Left(strTemp, Len(strTemp) - 9)
tmpBuff = Right(tmpBuff, 3)
If Val(tmpBuff) > 1 Then
Milliers(3) = Milliers(3) & "s"
End If
End If
'élaboration de la chaîne
If ValNum = 0 Or ValNum = 1 Then
strResultat = Unites(ValNum)
End If
For I = Len(strTemp) To 1 Step -1
ValNb = Val(Mid$(strTemp, I, 1))
nPosition = (Len(strTemp) - I) + 1
Select Case (nPosition Mod 3)
Case 1
LesZeros = False
If I = 1 Then
If ValNb > 1 Or (ValNb = 1 And nPosition > 4) Then
tmpBuff = Unites(ValNb) & " "
Else
tmpBuff = ""
End If
ElseIf Mid$(strTemp, I - 1, 1) = "1" Then
tmpBuff = Dixaines(ValNb) & " "
I = I - 1
ElseIf Mid$(strTemp, I - 1, 1) = "9" Then
tmpBuff = LesDixaines(8) & " " & Dixaines(ValNb) & " "
I = I - 1
ElseIf Mid$(strTemp, I - 1, 1) = "7" Then
If ValNb = 1 Then
tmpBuff = LesDixaines(6) & " et " & Dixaines(ValNb) & " "
Else
tmpBuff = LesDixaines(6) & " " & Dixaines(ValNb) & " "
End If
I = I - 1
ElseIf ValNb > 0 Then
tmpBuff = Unites(ValNb) & " "
Else
LesZeros = True
If I > 1 Then
If Mid$(strTemp, I - 1, 1) <> "0" Then
LesZeros = False
End If
End If
If I > 2 Then
If Mid$(strTemp, I - 2, 1) <> "0" Then
LesZeros = False
End If
End If
tmpBuff = ""
End If
If LesZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & Milliers(nPosition / 3) & " "
End If
strResultat = tmpBuff & strResultat
Case 2
If ValNb > 0 Then
If strResultat = "un " And ValNb <> 8 Then
strResultat = LesDixaines(ValNb) & " et " & strResultat
Else
strResultat = LesDixaines(ValNb) & " " & strResultat
End If
End If
Case 0
If ValNb > 0 Then
If ValNb > 1 Then
strResultat = Unites(ValNb) & " Cent " & strResultat
Else
strResultat = "Cent " & strResultat
End If
End If
End Select
Next I
strResultat = RTrim(strResultat)
'pluriel des centaines
If Len(strTemp) > 2 And Right(strTemp, 2) = "00" Then
tmpBuff = Mid(strTemp, Len(strTemp) - 2, 1)
If Val(tmpBuff) > 1 Then
strResultat = strResultat & "s"
End If
End If
'masjuscule optionnelle
If Len(strResultat) > 0 Then
If boo Then
strResultat = UCase$(Left$(strResultat, 1)) & Mid$(strResultat, 2)
End If
End If

EndNbVersTexte:
NbVersTexte = strResultat
Exit Function
NbVersTexteError:
strResultat = "Erreur de conversion !"
Resume EndNbVersTexte
End Function
[left][right]


 #2  
السبت 09 فبراير 2013, 18:45
 
 
 
ذكر
الاقامة : ALGERIE
المشاركات : 115
نقاط : 151
تاريخ التسجيل : 14/12/2010
العمر : 46
العمل : LOCALE
المزاج المزاج : مرح هادئ و بشوش
افتراضيرد: كود لتحويل التاريخ الى نص بالفرنسية (ارجوا المساعة في تحويله بالعربية)

اين انتم يا احبابي


 #3  
الأحد 10 فبراير 2013, 19:39
 
 
 
ذكر
الاقامة : naama
المشاركات : 184
نقاط : 267
تاريخ التسجيل : 14/05/2011
العمر : 38
العمل : خدام
المزاج المزاج : راها ترول
افتراضيرد: كود لتحويل التاريخ الى نص بالفرنسية (ارجوا المساعة في تحويله بالعربية)

عندي تطبيق لتحويل الارقام الى حروف بالعربية والفرنسية وكذلك لمعرفة irg لاي رقم . اي الضريبة على الدخل لكن لااعرف كيف اطرحه في المنتدى لكي يستفيد منه الجميع . في سبيل الله


 #4  
الإثنين 11 فبراير 2013, 17:34
 
 
 
ذكر
الاقامة : ALGERIE
المشاركات : 115
نقاط : 151
تاريخ التسجيل : 14/12/2010
العمر : 46
العمل : LOCALE
المزاج المزاج : مرح هادئ و بشوش
افتراضيرد: كود لتحويل التاريخ الى نص بالفرنسية (ارجوا المساعة في تحويله بالعربية)

اضغط الملفات و ادخل على موقع
[ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذا الرابط]
سجل فيه مجانا و قم برفع الملفات المضغوطة
و سيعطيك الموقع رابط التحميل انسخه هنا على المنتدى






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


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



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

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