سلام دوستان من قبلا يه كد از سايت گرفته بودم براي تبديل عدد به حروف ولي خوب وقتي ميخواستم ازش استفاده كنم ديدم كه كد مشكل داره و فارسي اعداد رو اشتباه بر ميگردونه واسه همين اقدام به نوشتن اين كدها كردم (ميخواستم توي وقت صرفه جويي كنم ولي تابع اي كه گرفته بودم اشتباه بود و مجبور شدم خودم بنويسم) اين تابع رو براي دوستان ميزارم كه اگر كسي نياز داشت ازش استفاده كنه
راستي اينم بگم كه دارم روي تبديل حروف فارسي به اعداد كار ميكنم و احتمال خيلي زياد تا جمعه آماده ميشه!
Private Function GetNumberString(ByVal Number As Integer) As String
Select Case Number
Case 1
GetNumberString = "يك"
Case 2
GetNumberString = "دو"
Case 3
GetNumberString = "سه"
Case 4
GetNumberString = "چهار"
Case 5
GetNumberString = "پنج"
Case 6
GetNumberString = "شش"
Case 7
GetNumberString = "هفت"
Case 8
GetNumberString = "هشت"
Case 9
GetNumberString = "نه"
Case 10
GetNumberString = "ده"
Case 11
GetNumberString = "يازده"
Case 12
GetNumberString = "دوازده"
Case 13
GetNumberString = "سيزده"
Case 14
GetNumberString = "چهارده"
Case 15
GetNumberString = "پانزده"
Case 16
GetNumberString = "شانزده"
Case 17
GetNumberString = "هفده"
Case 18
GetNumberString = "هجده"
Case 19
GetNumberString = "نوزده"
Case 20 To 29
GetNumberString = "بيست"
Case 30 To 39
GetNumberString = "سي"
Case 40 To 49
GetNumberString = "چهل"
Case 50 To 59
GetNumberString = "پنجاه"
Case 60 To 69
GetNumberString = "شصد"
Case 70 To 79
GetNumberString = "هفتاد"
Case 80 To 89
GetNumberString = "هشتاد"
Case 90 To 99
GetNumberString = "نود"
Case 100 To 199
GetNumberString = "يكصد"
Case 200 To 299
GetNumberString = "دويست"
Case 300 To 399
GetNumberString = "سيصد"
Case 400 To 499
GetNumberString = "چهارصد"
Case 500 To 599
GetNumberString = "پانصد"
Case 600 To 699
GetNumberString = "ششصد"
Case 700 To 799
GetNumberString = "هفتصد"
Case 800 To 800
GetNumberString = "هشتصد"
Case 900 To 999
GetNumberString = "نهصد"
Case Else
GetNumberString = ""
End Select
Return GetNumberString
End Function
Private Function GetString(ByVal Number As Integer) As String
Select Case Number
Case 1
GetString = "هزار"
Case 2
GetString = "ميليون"
Case 3
GetString = "ميليارد"
Case 4
GetString = "ترليون"
Case 5
GetString = "تلیارد"
Case Else
GetString = ""
End Select
Return GetString
End Function
Public Function NumToFarsi(ByVal Number As String) As String
NumToFarsi = ""
Dim strAux As String
Dim strComma As String
Dim strPeriod As String
strPeriod = ""
Number = Number.Replace(",", "")
If InStr(Number, ".") > 0 Then
strAux = Mid(Number, 1, InStr(Number, ".") - 1)
strPeriod = Mid(Number, InStr(Number, "."))
Else
strAux = Number
End If
strComma = strAux
strAux = ""
While strComma.Length > 3
strAux = "," & Mid(strComma, strComma.Length - 2, 3) & strAux
strComma = Mid(strComma, 1, strComma.Length - 3)
End While
strAux = strComma & strAux & strPeriod
If Mid(strAux, 1, 1) = "," Then strAux = Mid(strAux, 2)
Dim SplitNumber = Split(strAux, ",")
For i As Integer = 0 To UBound(SplitNumber)
If CInt(SplitNumber(i)) > 19 Then
For j As Integer = 1 To Len((SplitNumber(i)))
If CInt(SplitNumber(i)) > 0 Then
Dim Num As Integer = CInt(Mid(CInt(SplitNumber(i)), j))
If Num > 0 And Num <= 19 Then
NumToFarsi &= " و " & GetNumberString(Num)
Exit For
ElseIf Num > 19 Then
NumToFarsi &= " و " & GetNumberString(Num)
End If
End If
Next j%
ElseIf CInt(SplitNumber(i)) <= 19 And CInt(SplitNumber(i)) > 0 Then
NumToFarsi &= " و " & GetNumberString(SplitNumber(i))
End If
If CInt(SplitNumber(i)) > 0 Then
NumToFarsi &= " " & GetString(UBound(SplitNumber) - i)
End If
Next
If Mid(Trim(NumToFarsi), NumToFarsi.Length - 1) = "و" Then
End If
If Mid(Trim(NumToFarsi), NumToFarsi.Length - 1) = "و" Then
NumToFarsi = Mid(Trim(NumToFarsi), NumToFarsi.Length - 1)
ElseIf Mid(Trim(NumToFarsi), 1, 1) = "و" Then
NumToFarsi = Mid(Trim(NumToFarsi), 2)
End If
Return NumToFarsi
End Function
طريقه استفاده از كدها
MsgBox(NumToFarsi(TextBox1.Text))
Module همين كد رو هم براتون Attach ميكنم
پاسخ با نقل قول