اقدم لكم ابسط واسرع تفقيط في الكريستل ريبورت او اي وظيفة خارجية

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

No2ArabicTxt.rar

KARIMSOFT كتب:

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

اخي karimsoft

اشكرك جزيل الشكر على طح هذ الوضوع،

ما هو الاصدار المستخدم في برمجة هذا التقرير، حيث انني استخدم الاصدار ولم استطيع تشغيل هذا الملف

السلام عليكــم ورحمـة الله وبركاتــه ،،

انا استخدم الاصدارة العاشرة واتقد ان الفكره يكطن تنفذها علي اي اصدار

تعتمد الفكرة علي اداج Formula بها تلك الشفر ويكون الكود فجوال بيسك

Dim sStrNo, sResult, c1, c2, c3, sMidStrNo As String
Dim nLenNo, nLoop As number
sResult = ""
sStrNo = CStr(field name the number)
If Left(Right(sStrNo, 2), 1) = "." Then sStrNo = sStrNo & "0"
If Left(Right(sStrNo, 3), 1) <> "." Then sStrNo = sStrNo & ".00"
sStrNo = Trim(sStrNo)
nLenNo = Len(sStrNo)
nLoop = 1
Do While nLenNo > 0
c1 = ""
c2 = ""
c3 = ""
If nLenNo = 12 Or nLenNo = 9 Or nLenNo = 6 Then
sMidStrNo = Mid(sStrNo, nLoop, 1)
nLenNo = nLenNo - 1
Select Case sMidStrNo
Case "0"
c3 = ""
Case "1"
c3 = "ومائة "
Case "2"
c3 = "ومائتان "
Case "3"
c3 = "وثلاثمائة "
Case "4"
c3 = "واربعمائة "
Case "5"
c3 = "وخمسمائة "
Case "6"
c3 = "وستمائة "
Case "7"
c3 = "وسبعمائة "
Case "8"
c3 = "وثمانمائة "
Case "9"
c3 = "وتسعمائة "
End Select
nLoop = nLoop + 1
End If
If nLenNo = 3 Then
nLoop = nLoop + 1
nLenNo = nLenNo - 1
End If
sMidStrNo = Mid(sStrNo, nLoop, 1)
If nLenNo = 2 Or nLenNo = 5 Or nLenNo = 8 Or nLenNo = 11 Then
Select Case sMidStrNo
Case "0"
c2 = ""
Case "1"
c2 = "عشر "
Case "2"
c2 = "وعشرون "
Case "3"
c2 = "وثلاثون "
Case "4"
c2 = "واربعون "
Case "5"
c2 = "وخمسون "
Case "6"
c2 = "وستون "
Case "7"
c2 = "وسبعون "
Case "8"
c2 = "وثمانون "
Case "9"
c2 = "وتسعون "
End Select
nLenNo = nLenNo - 1
nLoop = nLoop + 1
End If
sMidStrNo = Mid(sStrNo, nLoop, 1)
If nLenNo = 1 Then ' قروش
Select Case sMidStrNo
Case "0"
c1 = ""
Case "1"
If c2 = "عشر " Then
c1 = "واحدى "
Else
c1 = "وواحد "
End If
Case "2"
If c2 = "عشر " Then
c1 = "واثنتا "
Else
c1 = "واثناتان "
End If
Case "3"
c1 = "وثلاث "
Case "4"
c1 = "واربع "
Case "5"
c1 = "وخمس "
Case "6"
c1 = "وست "
Case "7"
c1 = "وسبع "
Case "8"
c1 = "وثمان "
Case "9"
c1 = "وتسع "
End Select
Else ' جنهات
Select Case sMidStrNo
Case "0"
c1 = ""
If c2 = "عشر " Then
c2 = "وعشرة "
End If
Case "1"
If c2 = "عشر " Then
c1 = "واحدى "
Else
c1 = "وواحد "
End If
Case "2"
If c2 = "عشر " Then
c1 = "واثنا "
Else
c1 = "واثنان "
End If
Case "3"
c1 = "وثلاثة "
Case "4"
c1 = "واربعة "
Case "5"
c1 = "وخمسة "
Case "6"
c1 = "وستة "
Case "7"
c1 = "وسبعة "
Case "8"
c1 = "وثمانة "
Case "9"
c1 = "وتسعة "
End Select
End If
nLenNo = nLenNo - 1
nLoop = nLoop + 1
Select Case nLenNo
Case 9
Select Case c1 + c2 + c3
Case "وواحد "
sResult = sResult + "ومليون "
Case "واثنان "
sResult = sResult + "ومليونان"
Case Else
sResult = sResult + c3 + c1 + c2 + "مليون "
End Select
Case 6
Select Case c1 + c2 + c3
Case "وواحد "
sResult = sResult + "والف "
Case "واثنان "
sResult = sResult + "والفان "
Case "وثلاثة "
sResult = sResult + "وثلاثة الاف "
Case "واربعة "
sResult = sResult + "واربعة الاف "
Case "وخمسة "
sResult = sResult + "وخمسة الاف "
Case "وستة "
sResult = sResult + "وستة الاف "
Case "وسبعة "
sResult = sResult + "وسبعة الاف "
Case "وثمانية "
sResult = sResult + "وثمانية الاف "
Case "وتسعة "
sResult = sResult + "وتسعة الاف "
Case Else
If c2 = "وعشرة " Then
sResult = sResult + c3 + c1 + c2 + "الاف "
Else
sResult = sResult + c3 + c1 + c2 + "الف "
End If
End Select
Case 3
If c2 = "" Then
Select Case c1
Case ""
c1 = "جنيه "
Case "وواحد "
c1 = "وجنيه "
Case "واثنان "
c1 = "وجنيهان "
Case "وثلاثة "
c1 = "وثلاثة جنيهات "
Case "واربعة "
c1 = "واربعة جنيهات "
Case "وخمسة "
c1 = "وخمسة جنيهات "
Case "وستة "
c1 = "وستة جنيهات "
Case "وسبعة "
c1 = "وسبعة جنيهات "
Case "وثمانية "
c1 = "وثمانية جنيهات "
Case "وتسعة "
c1 = "وتسعة جنيهات "
End Select
sResult = sResult + c3 + c1 + c2
Else
sResult = sResult + c3 + c1 + c2 + "جنيهاً "
End If
Case 0
If c1 + c2 <> "" Then
If c2 = "" Then
Select Case c1
Case "وواحد "
sResult = sResult + "وقرش واحد"
Case "واثنان "
sResult = sResult + "وقرشان "
Case Else
sResult = sResult + c1 + "قروش "
End Select
Else
sResult = sResult + c1 + c2 + "قرش "
End If
End If
End Select
Loop
sResult = LTrim(sResult)
nLenNo = Len(sResult) - 1
If Left(sResult, 1) = "و" Then
sResult = Mid(sResult, 2, nLenNo)
End If
formula = sResult

up