ali_najari
چهارشنبه 19 آبان 1389, 22:30 عصر
دوستان کدی که گفتم تا جمعه آماده میکنم ورژن اولش رو همین امروز آماده کردم ولی خوب بازم زمان نیازه که کاملش کنم ولی همین ورژن اولش نسبتا جواب میده
موفق باشید! (Ti-amo )
http://barnamenevis.org/forum/attachment.php?attachmentid=60031&d=1289416588
Module ConvertPersianToNumber
Private Function GetNumberOfString(ByVal Number As String) As Integer
Number = Replace(Number, "ی", "ي")
If Trim(Number) <> "" Then
Select Case Trim(Number)
Case "صفر"
GetNumberOfString = 0
Case "يک"
GetNumberOfString = 1
Case "دو"
GetNumberOfString = 2
Case "سه"
GetNumberOfString = 3
Case "چهار"
GetNumberOfString = 4
Case "پنج"
GetNumberOfString = 5
Case "شش"
GetNumberOfString = 6
Case "هفت"
GetNumberOfString = 7
Case "هشت"
GetNumberOfString = 8
Case "نه"
GetNumberOfString = 9
Case "ده"
GetNumberOfString = 10
Case "يازده"
GetNumberOfString = 11
Case "دوازده"
GetNumberOfString = 12
Case "سيزده"
GetNumberOfString = 13
Case "چهارده"
GetNumberOfString = 14
Case "پانزده"
GetNumberOfString = 15
Case "شانزده"
GetNumberOfString = 16
Case "هفده"
GetNumberOfString = 17
Case "هجده"
GetNumberOfString = 18
Case "نوزده"
GetNumberOfString = 19
Case "بيست"
GetNumberOfString = 20
Case "سي"
GetNumberOfString = 30
Case "چهل"
GetNumberOfString = 40
Case "پنجاه"
GetNumberOfString = 50
Case "شصت"
GetNumberOfString = 60
Case "هفتاد"
GetNumberOfString = 70
Case "هشتاد"
GetNumberOfString = 80
Case "نود"
GetNumberOfString = 90
Case "يکصد"
GetNumberOfString = 100
Case "دويست"
GetNumberOfString = 200
Case "سيصد"
GetNumberOfString = 300
Case "چهارصد"
GetNumberOfString = 400
Case "پانصد"
GetNumberOfString = 500
Case "ششصد"
GetNumberOfString = 600
Case "هفتصد"
GetNumberOfString = 700
Case "هشتصد"
GetNumberOfString = 800
Case "نهصد"
GetNumberOfString = 900
End Select
End If
Return GetNumberOfString
End Function
Public Function TextToNumber(ByVal [String] As String) As String
TextToNumber = 0
[String] = Replace([String], "ريال", "")
[String] = Replace([String], "تومان", "")
[String] = Replace([String], "ی", "ي")
Dim SplitString = Split(Trim([String]), " و ")
Dim Num As String = 0
For i As Integer = 0 To UBound(SplitString)
Dim Split1 = Split(Trim(SplitString(i)), " ")
For j As Integer = 0 To UBound(Split1)
Select Case Trim(Split1(j))
Case "هزار"
TextToNumber = Val(TextToNumber) + (Val(Num) * 1000)
Num = 0
Case "ميليون"
TextToNumber = Val(TextToNumber) + (Val(Num) * 1000000)
Num = 0
Case "ميليارد"
TextToNumber = Val(TextToNumber) + (Val(Num) * 1000000000)
Num = 0
Case "ترليون"
TextToNumber = Val(TextToNumber) + (Val(Num) * 1000000000000)
Num = 0
Case "ترليارد"
TextToNumber = Val(TextToNumber) + (Val(Num) * 1000000000000000)
Num = 0
Case Else
If i = UBound(SplitString) And j = UBound(Split1) Then
Num = Val(Num) + Val(GetNumberOfString(Split1(j)))
TextToNumber = Val(TextToNumber) + Val(Num)
Num = 0
Else
Num = Val(Num) + Val(GetNumberOfString(Split1(j)))
End If
End Select
Next
Next
Return TextToNumber
End Function
End Module
:گیج::قلب::خجالت::کف::لبخند::چ مک:
موفق باشید! (Ti-amo )
http://barnamenevis.org/forum/attachment.php?attachmentid=60031&d=1289416588
Module ConvertPersianToNumber
Private Function GetNumberOfString(ByVal Number As String) As Integer
Number = Replace(Number, "ی", "ي")
If Trim(Number) <> "" Then
Select Case Trim(Number)
Case "صفر"
GetNumberOfString = 0
Case "يک"
GetNumberOfString = 1
Case "دو"
GetNumberOfString = 2
Case "سه"
GetNumberOfString = 3
Case "چهار"
GetNumberOfString = 4
Case "پنج"
GetNumberOfString = 5
Case "شش"
GetNumberOfString = 6
Case "هفت"
GetNumberOfString = 7
Case "هشت"
GetNumberOfString = 8
Case "نه"
GetNumberOfString = 9
Case "ده"
GetNumberOfString = 10
Case "يازده"
GetNumberOfString = 11
Case "دوازده"
GetNumberOfString = 12
Case "سيزده"
GetNumberOfString = 13
Case "چهارده"
GetNumberOfString = 14
Case "پانزده"
GetNumberOfString = 15
Case "شانزده"
GetNumberOfString = 16
Case "هفده"
GetNumberOfString = 17
Case "هجده"
GetNumberOfString = 18
Case "نوزده"
GetNumberOfString = 19
Case "بيست"
GetNumberOfString = 20
Case "سي"
GetNumberOfString = 30
Case "چهل"
GetNumberOfString = 40
Case "پنجاه"
GetNumberOfString = 50
Case "شصت"
GetNumberOfString = 60
Case "هفتاد"
GetNumberOfString = 70
Case "هشتاد"
GetNumberOfString = 80
Case "نود"
GetNumberOfString = 90
Case "يکصد"
GetNumberOfString = 100
Case "دويست"
GetNumberOfString = 200
Case "سيصد"
GetNumberOfString = 300
Case "چهارصد"
GetNumberOfString = 400
Case "پانصد"
GetNumberOfString = 500
Case "ششصد"
GetNumberOfString = 600
Case "هفتصد"
GetNumberOfString = 700
Case "هشتصد"
GetNumberOfString = 800
Case "نهصد"
GetNumberOfString = 900
End Select
End If
Return GetNumberOfString
End Function
Public Function TextToNumber(ByVal [String] As String) As String
TextToNumber = 0
[String] = Replace([String], "ريال", "")
[String] = Replace([String], "تومان", "")
[String] = Replace([String], "ی", "ي")
Dim SplitString = Split(Trim([String]), " و ")
Dim Num As String = 0
For i As Integer = 0 To UBound(SplitString)
Dim Split1 = Split(Trim(SplitString(i)), " ")
For j As Integer = 0 To UBound(Split1)
Select Case Trim(Split1(j))
Case "هزار"
TextToNumber = Val(TextToNumber) + (Val(Num) * 1000)
Num = 0
Case "ميليون"
TextToNumber = Val(TextToNumber) + (Val(Num) * 1000000)
Num = 0
Case "ميليارد"
TextToNumber = Val(TextToNumber) + (Val(Num) * 1000000000)
Num = 0
Case "ترليون"
TextToNumber = Val(TextToNumber) + (Val(Num) * 1000000000000)
Num = 0
Case "ترليارد"
TextToNumber = Val(TextToNumber) + (Val(Num) * 1000000000000000)
Num = 0
Case Else
If i = UBound(SplitString) And j = UBound(Split1) Then
Num = Val(Num) + Val(GetNumberOfString(Split1(j)))
TextToNumber = Val(TextToNumber) + Val(Num)
Num = 0
Else
Num = Val(Num) + Val(GetNumberOfString(Split1(j)))
End If
End Select
Next
Next
Return TextToNumber
End Function
End Module
:گیج::قلب::خجالت::کف::لبخند::چ مک: