PDA

View Full Version : مشکل در تبدیل عدد به حروف در کریستال ریپورت



safa55
جمعه 14 فروردین 1394, 23:10 عصر
سلام دوستان
من نیاز فوری به تابعی دارم که عدد را به حروف تبدیل کنه (فقط در کریستال ریپورت).
چندین تابع را استفاده کردم ولی جوابی نگرفتم خودم هم تابعی نوشتم ولی اون هم در بعضی جاها درست جواب نمی ده.
کسی می تونه مشکل ما رو حل کنه؟
لطفا جوابی یا کدی را معرفی کنید که درست باشه. فقط در کریستال می خوام.

safa55
یک شنبه 16 فروردین 1394, 08:15 صبح
کسی نیست جوابی بده!!!؟؟؟
همه سایت رو گشتم ولی اکثر مطالب مرتبط یا غلط هستند و یا کامل نیستند.

safa55
دوشنبه 17 فروردین 1394, 18:38 عصر
دوستان خودم topic درست می کنم و خودم جواب میدم :)
کسی جواب نداد باعث شد خودم کد اش رو بنویسم.
تقریبا کد زیر با کمی تکمیل کردن تا عدد یک میلیون رو تبدیل می کنه. ولی من انتظار داشتم که کد کمتری داشته باشد ، مثلا بازگشتی می شد و....
به هر حال لطفا نظر بدید به کد. در ضمن من عجله ای نوشتم بهینه تر از این هم می شود.
منتظر نظر ، پیشنهاد و .... هستم.

Function PersianNumber (n As Number) as String
dim arr1() as string
dim arr2() as string
dim arr3() as string
dim m As Number
dim m1 As Number
dim m2 As Number
dim m3 As Number
dim m4 As Number

dim m11 As Number
dim m12 As Number
dim m13 As Number
dim m14 As Number
arr1=Array("","یک", "دو", "سه", "چهار", "پنج", "شش","هفت", "هشت", "نه", "ده", "یازده", "دوازده", "سیزده", _
"چهارده", "پانزده", "شانزده", "هفده", "هجده", "نوزده")
arr2=Array("","بیست", "سی", "چهل", "پنجاه", "شصت","هفتاد", "هشتاد", "نود")
arr3=Array("","صد", "دویست", "سیصد", "چهارصد", "پانصد","ششصد", "هفتصد", "هشتصد", "نهصد")
Select Case n
Case 0
PersianNumber= ""
Case 1 To 19
PersianNumber= arr1(n) & " "
Case 20 To 99

PersianNumber= arr2(n \ 10 ) & " " & arr1((n Mod 10)+1)
Case 100 To 199
m= n Mod 100
m1= m mod 10
if(m>0) then
if(m1>0) then
PersianNumber= "صد" +" و "+ arr2(m \ 10 ) +" و "+ arr1(m1+1)
else
PersianNumber= "صد" +" و "+ arr2(m\10)
end if
else
PersianNumber= "صد"
end if
Case 200 To 999
m= n \ 100
m1= n Mod 100
if(m1>10) then
m2=m1\10
m3= m1 mod 10
PersianNumber= arr3(m+1) +" و "+ arr2(m2+1) +" و "+ arr1(m3+1)
else
if(m1>0) then
PersianNumber= arr3(m+1) +" و "+ arr1(m1+1)
else
PersianNumber= arr3(m+1)
end if
end If

Case 1000 To 1999

m= n mod 1000 '218
m1= m \ 100 '2
m=m mod 100 '18
m2=m \ 10 '1
m3= m Mod 10 '8
if((n mod 1000)>0) then
if(m>19) then
if(m3>0) then
PersianNumber= "هزار " +" و "+ arr3(m1+1) +" و "+ arr2(m2) +" و "+ arr1(m3+1)
else
PersianNumber= "هزار " +" و "+ arr3(m1+1)+" و "+ arr2(m2)
end if
else

PersianNumber= "هزار " +" و "+ arr3(m1+1) +" و "+ arr1(m+1)
end If
else
PersianNumber= "هزار "
End If
Case 2000 To 999999 '200000
m= n \ 1000 '20
m1=m\100 '0
m2= m mod 100 '0
m4=m2\10 '0
m3=m2 mod 10 '0
m=n mod 1000 '909
m11=m\100 '9
m12=m mod 100 '9
m13=m12\10 '0
m14=m12 mod 10 '0
if(m2>19) then
if(m4>0) then
if(m3>0) then
if(m12>19) then
if(m13>0) then
if(m14>0) then
PersianNumber= arr3(m1+1)+" و "+arr2(m4)+" و "+ arr1(m3+1) + " هزار "+ " و " + arr3(m11+1)+" و "+arr2(m13)+" و "+ arr1(m14+1)
else
PersianNumber= arr3(m1+1)+" و "+arr2(m4)+" و "+ arr1(m3+1) + " هزار "+ " و " + arr3(m11+1)+" و "+arr2(m13)
end if
else
PersianNumber= arr3(m1+1)+" و "+arr2(m4)+" و "+ arr1(m3+1) + " هزار "+ " و " + arr3(m11+1)+" و "+ arr1(m14+1)

end if
else
PersianNumber= arr3(m1+1)+" و "+arr2(m4)+" و "+ arr1(m3+1) + " هزار "+ " و " + arr3(m11+1)+" و "+ arr1(m12+1)
end if
else
PersianNumber= arr3(m1+1)+" و "+arr2(m4)+ " هزار و " +......
end if
else
PersianNumber= arr3(m1+1)+" و "+arr2(m4)+" و "+ arr1(m3+1) + " هزار و "' +.....
end if
else

PersianNumber=arr3(m1+1)+" و "+arr1(m2+1) + " هزار "

End If

End Select
End Function