21-11-17, 04:53 PM
قمت باضافة الدالة التالية للكريستال ريبورت
لكن المشكلة الكريستال ريبورت لايدعم الاعادة الذاتية
او لم اعرف الطريقة لهذا كررت الدالة
لكن المشكلة الكريستال ريبورت لايدعم الاعادة الذاتية
او لم اعرف الطريقة لهذا كررت الدالة
كود :
Function myfuc100(d as number) as string
dim i as Number
Dim C As String
Dim C1 As String
dim x as Number
dim f as string
c=CStr(d)
c=Replace(c,",","")
x=instr(c,".")
c= Left(c,len(c)-3)
for i=1 to 12-len(c)
c="0"+c
next i
C1 = Mid(C, 12, 1)
Dim Letter1 As String
Select Case C1
Case "1"
Letter1 = "واحد"
Case "2"
Letter1 = "اثنان"
Case "3"
Letter1 = "ثلاثة"
Case "4"
Letter1 = "اربعة"
Case "5"
Letter1 = "خمسة"
Case "6"
Letter1 = "ستة"
Case "7"
Letter1 = "سبعة"
Case "8"
Letter1 = "ثمانية"
Case "9"
Letter1 = "تسعة"
End Select
Dim C2 As string
C2 = Mid(C, 11, 1)
Dim Letter2 As String
Select Case C2
Case "1"
Letter2 = "عشر"
Case "2"
Letter2 = "عشرون"
Case "3"
Letter2 = "ثلاثون"
Case "4"
Letter2 = "اربعون"
Case "5"
Letter2 = "خمسون"
Case "6"
Letter2 = "ستون"
Case "7"
Letter2 = "سبعون"
Case "8"
Letter2 = "ثمانون"
Case "9"
Letter2 = "تسعون"
End Select
If Letter1 <> "" And C2 > "1" Then Letter2 = Letter1 + " و" + Letter2
If Letter2 = "" Then Letter2 = Letter1
If C1 = "0" And C2 = "1" Then Letter2 = Letter2 + "ة"
If C1 = "1" And C2 = "1" Then Letter2 = "احدى عشر"
If C1 = "2" And C2 = "1" Then Letter2 = "اثنى عشر"
If C1 > "2" And C2 = "1" Then Letter2 = Letter1 + " " + Letter2
Dim C3 As Number
C3 = Val(Mid(C, 10, 1))
Dim Letter3 As String
Select Case C3
Case 1
Letter3 = "مائة"
Case 2
Letter3 = "مئتان"
Case 3,4,5,6,7,8,9
f=myfuc1001(C3)
Letter3 = left(f, Len(f) - 1) + "مائة"
End Select
If Letter3 <> "" And Letter2 <> "" Then Letter3 = Letter3 + " و" + Letter2
If Letter3 = "" Then Letter3 = Letter2
Dim C4 As Number
C4 = Val(Mid(C, 7, 3))
Dim Letter4 As String
Select Case C4
Case 1
Letter4 = "الف"
Case 2
Letter4 = "الفان"
Case 3 To 10
Letter4 = myfuc1001(C4) + " آلاف"
Case Is > 10
Letter4 = myfuc1001(C4) + " الف"
End Select
If Letter4 <> "" And Letter3 <> "" Then Letter4 = Letter4 + " و" + Letter3
If Letter4 = "" Then Letter4 = Letter3
Dim C5 As Number
C5 = Val(Mid(C, 4, 3))
Dim Letter5 As String
Select Case C5
Case 1
Letter5 = "مليون"
Case 2
Letter5 = "مليونان"
Case 3 To 10
Letter5 = myfuc1001(C5) + " ملايين"
Case Is > 10
Letter5 = myfuc1001(C5) + " مليون"
End Select
If Letter5 <> "" And Letter4 <> "" Then Letter5 = Letter5 + " و" + Letter4
If Letter5 = "" Then Letter5 = Letter4
Dim C6 As Number
C6 = Val(Mid(C, 1, 3))
Dim Letter6 As String
Select Case C6
Case 1
Letter6 = "مليار"
Case 2
Letter6 = "ملياران"
Case Is > 2
Letter6 = myfuc1001(C6) + " مليار"
End Select
If Letter6 <> "" And Letter5 <> "" Then Letter6 = Letter6 + " و" + Letter5
If Letter6 = "" Then Letter6 = Letter5
myfuc100 =Letter6
end function
كود :
Function myfuc1001(d as number) as string
dim i as Number
Dim C As String
Dim C1 As String
dim x as Number
dim f as string
c=CStr(d)
c=Replace(c,",","")
x=instr(c,".")
c= Left(c,len(c)-3)
for i=1 to 12-len(c)
c="0"+c
next i
C1 = Mid(C, 12, 1)
Dim Letter1 As String
Select Case C1
Case "1"
Letter1 = "واحد"
Case "2"
Letter1 = "اثنان"
Case "3"
Letter1 = "ثلاثة"
Case "4"
Letter1 = "اربعة"
Case "5"
Letter1 = "خمسة"
Case "6"
Letter1 = "ستة"
Case "7"
Letter1 = "سبعة"
Case "8"
Letter1 = "ثمانية"
Case "9"
Letter1 = "تسعة"
End Select
Dim C2 As string
C2 = Mid(C, 11, 1)
Dim Letter2 As String
Select Case C2
Case "1"
Letter2 = "عشر"
Case "2"
Letter2 = "عشرون"
Case "3"
Letter2 = "ثلاثون"
Case "4"
Letter2 = "اربعون"
Case "5"
Letter2 = "خمسون"
Case "6"
Letter2 = "ستون"
Case "7"
Letter2 = "سبعون"
Case "8"
Letter2 = "ثمانون"
Case "9"
Letter2 = "تسعون"
End Select
If Letter1 <> "" And C2 > "1" Then Letter2 = Letter1 + " و" + Letter2
If Letter2 = "" Then Letter2 = Letter1
If C1 = "0" And C2 = "1" Then Letter2 = Letter2 + "ة"
If C1 = "1" And C2 = "1" Then Letter2 = "احدى عشر"
If C1 = "2" And C2 = "1" Then Letter2 = "اثنى عشر"
If C1 > "2" And C2 = "1" Then Letter2 = Letter1 + " " + Letter2
Dim C3 As Number
C3 = Val(Mid(C, 10, 1))
Dim Letter3 As String
Select Case C3
Case 1
Letter3 = "مائة"
Case 2
Letter3 = "مئتان"
Case 3,4,5,6,7,8,9
f=myfuc1001(C3)
' Letter3 = Left(f, Len(f) - 1) + "مائة"
Letter3 = f+ "مائة"
End Select
If Letter3 <> "" And Letter2 <> "" Then Letter3 = Letter3 + " و" + Letter2
If Letter3 = "" Then Letter3 = Letter2
Dim C4 As Number
C4 = Val(Mid(C, 7, 3))
Dim Letter4 As String
Select Case C4
Case 1
Letter4 = "الف"
Case 2
Letter4 = "الفان"
Case 3 To 10
Letter4 = myfuc1001(C4) + " آلاف"
Case Is > 10
Letter4 = myfuc1001(C4) + " الف"
End Select
If Letter4 <> "" And Letter3 <> "" Then Letter4 = Letter4 + " و" + Letter3
If Letter4 = "" Then Letter4 = Letter3
Dim C5 As Number
C5 = Val(Mid(C, 4, 3))
Dim Letter5 As String
Select Case C5
Case 1
Letter5 = "مليون"
Case 2
Letter5 = "مليونان"
Case 3 To 10
Letter5 = myfunc(C5) + " ملايين"
Case Is > 10
Letter5 = myfunc(C5) + " مليون"
End Select
If Letter5 <> "" And Letter4 <> "" Then Letter5 = Letter5 + " و" + Letter4
If Letter5 = "" Then Letter5 = Letter4
Dim C6 As Number
C6 = Val(Mid(C, 1, 3))
Dim Letter6 As String
Select Case C6
Case 1
Letter6 = "مليار"
Case 2
Letter6 = "ملياران"
Case Is > 2
Letter6 = myfunc(C6) + " مليار"
End Select
If Letter6 <> "" And Letter5 <> "" Then Letter6 = Letter6 + " و" + Letter5
If Letter6 = "" Then Letter6 = Letter5
myfuc1001 =Letter6
end function