Merhaba arkadaşlar
Benim bu yeni TL ye çevirme kodunda içinden çıkamadığım bir sorunum var Kodlarrı aşağıya yazacağım sorunşu
1111 yazıpta ytl ye çavirmek istedigimde
Bir Bin Bir Yüz Onbir Lira sıfır Kuruş
diye yazıyor. lütfen bu yanlışlık nereden geliyor bakarmısınız.
Selamlar... :lol:
Option Explicit
Function yaz(ByVal Tutar)
Dim kg, cent, Temp
Dim DecimalPlace, Count
Dim pozitif, x As Integer
Dim a$, s$, e$
Dim alt_birim As String
Dim döviz As String
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v(15)
Dim C(3)
b$(0) = ""
b$(1) = " bir"
b$(2) = " iki"
b$(3) = " üç"
b$(4) = " dört"
b$(5) = " beş"
b$(6) = " altı"
b$(7) = " yedi"
b$(8) = " sekiz"
b$(9) = " dokuz"
y$(0) = " "
y$(1) = " on"
y$(2) = " yirmi"
y$(3) = " otuz"
y$(4) = " kırk"
y$(5) = " elli"
y$(6) = " altmış"
y$(7) = " yetmiş"
y$(8) = " seksen"
y$(9) = " doksan"
m$(0) = " trilyon"
m$(1) = " milyar"
m$(2) = " milyon"
m$(3) = " bin"
m$(4) = " "
a$ = Str(Tutar)
If Left$(Str(Tutar), 1) = " " Then pozitif = 1 Else pozitif = 0
a$ = Right$(a$, Len(a$) - 1)
s$ = ""
For x = 0 To 4
C(1) = v((x * 3) + 1)
C(2) = v((x * 3) + 2)
C(3) = v((x * 3) + 3)
If C(1) = 0 Then
e$ = ""
ElseIf C(1) = 1 Then
e$ = " Yüz"
Else
e$ = b$(C(1)) + " yüz"
End If
e$ = e$ + y$(C(2)) + b$(C(3))
If e$ <> "" Then e$ = e$ + m$(x)
If (x = 3) And (e$ = " birbin") Then e$ = " bin"
s$ = s$ + e$
Next x
If s$ = "" Then s$ = " sıfır"
If pozitif = 0 Then s$ = " Eksi" + s$
ReDim Place(10) As String
Place(2) = " Bin"
Place(3) = " Milyon"
Place(4) = " Milyar"
Place(5) = " Trilyon"
Tutar = Trim(Str(Tutar))
DecimalPlace = InStr(Tutar, ".")
If DecimalPlace > 0 Then
cent = GetHundreds(Left(Mid(Tutar, DecimalPlace + 1) & "00", 2))
Tutar = Trim(Left(Tutar, DecimalPlace - 1))
End If
Count = 1
Do While Tutar <> ""
Temp = GetHundreds(Right(Tutar, 3))
If Temp <> "" Then kg = Temp & Place(Count) & kg
If Len(Tutar) > 3 Then
Tutar = Left(Tutar, Len(Tutar) - 3)
If Left(kg, 6) = " BirBin" Then kg = Mid(kg, 4, Len(kg))
If Left(kg, 6) = " BirYüz" Then kg = Mid(kg, 4, Len(kg))
Else
Tutar = ""
End If
Count = Count + 1
Loop
If Left(kg, 6) = " BirBin" Then kg = Mid(kg, 4, Len(kg))
If Left(kg, 6) = " BirYüz" Then kg = Mid(kg, 4, Len(kg))
Select Case cent
Case ""
cent = " sıfır " & alt_birim
Case " Bir"
cent = " bir " & alt_birim
Case Else
cent = " " & cent & " " & alt_birim
End Select
If Left(cent, 12) = " Bir Yüz " Then cent = " " & Mid(cent, 8, Len(cent))
yaz = kg & " Lira" & cent & " Kuruş"
tamam:
End Function
Function GetHundreds(ByVal Tutar)
Dim Result As String
If Val(Tutar) = 0 Then Exit Function
Tutar = Right("000" & Tutar, 3)
If Mid(Tutar, 1, 1) <> "0" Then
Result = GetDigit(Mid(Tutar, 1, 1)) & " Yüz"
End If
If Mid(Tutar, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(Tutar, 2))
Else
Result = Result & GetDigit(Mid(Tutar, 3))
End If
GetHundreds = Result
End Function
Function GetTens(TensText)
Dim Result As String
Result = ""
If Val(Left(TensText, 1)) = 1 Then
Select Case Val(TensText)
Case 10: Result = " On"
Case 11: Result = " Onbir"
Case 12: Result = " Oniki"
Case 13: Result = " Onüç"
Case 14: Result = " Ondört"
Case 15: Result = " Onbeş"
Case 16: Result = " Onaltı"
Case 17: Result = " Onyedi"
Case 18: Result = " Onsekiz"
Case 19: Result = " Ondokuz"
Case Else
End Select
Else
Select Case Val(Left(TensText, 1))
Case 2: Result = " Yirmi"
Case 3: Result = " Otuz"
Case 4: Result = " Kırk"
Case 5: Result = " Elli"
Case 6: Result = " Altmış"
Case 7: Result = " Yetmiş"
Case 8: Result = " Seksen"
Case 9: Result = " Doksan"
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1))
End If
GetTens = Result
End Function
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = " Bir"
Case 2: GetDigit = " İki"
Case 3: GetDigit = " Üç"
Case 4: GetDigit = " Dört"
Case 5: GetDigit = " Beş"
Case 6: GetDigit = " Altı"
Case 7: GetDigit = " Yedi"
Case 8: GetDigit = " Sekiz"
Case 9: GetDigit = " Dokuz"
Case Else: GetDigit = " "
End Select
End Function
Benim bu yeni TL ye çevirme kodunda içinden çıkamadığım bir sorunum var Kodlarrı aşağıya yazacağım sorunşu
1111 yazıpta ytl ye çavirmek istedigimde
Bir Bin Bir Yüz Onbir Lira sıfır Kuruş
diye yazıyor. lütfen bu yanlışlık nereden geliyor bakarmısınız.
Selamlar... :lol:
Option Explicit
Function yaz(ByVal Tutar)
Dim kg, cent, Temp
Dim DecimalPlace, Count
Dim pozitif, x As Integer
Dim a$, s$, e$
Dim alt_birim As String
Dim döviz As String
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v(15)
Dim C(3)
b$(0) = ""
b$(1) = " bir"
b$(2) = " iki"
b$(3) = " üç"
b$(4) = " dört"
b$(5) = " beş"
b$(6) = " altı"
b$(7) = " yedi"
b$(8) = " sekiz"
b$(9) = " dokuz"
y$(0) = " "
y$(1) = " on"
y$(2) = " yirmi"
y$(3) = " otuz"
y$(4) = " kırk"
y$(5) = " elli"
y$(6) = " altmış"
y$(7) = " yetmiş"
y$(8) = " seksen"
y$(9) = " doksan"
m$(0) = " trilyon"
m$(1) = " milyar"
m$(2) = " milyon"
m$(3) = " bin"
m$(4) = " "
a$ = Str(Tutar)
If Left$(Str(Tutar), 1) = " " Then pozitif = 1 Else pozitif = 0
a$ = Right$(a$, Len(a$) - 1)
s$ = ""
For x = 0 To 4
C(1) = v((x * 3) + 1)
C(2) = v((x * 3) + 2)
C(3) = v((x * 3) + 3)
If C(1) = 0 Then
e$ = ""
ElseIf C(1) = 1 Then
e$ = " Yüz"
Else
e$ = b$(C(1)) + " yüz"
End If
e$ = e$ + y$(C(2)) + b$(C(3))
If e$ <> "" Then e$ = e$ + m$(x)
If (x = 3) And (e$ = " birbin") Then e$ = " bin"
s$ = s$ + e$
Next x
If s$ = "" Then s$ = " sıfır"
If pozitif = 0 Then s$ = " Eksi" + s$
ReDim Place(10) As String
Place(2) = " Bin"
Place(3) = " Milyon"
Place(4) = " Milyar"
Place(5) = " Trilyon"
Tutar = Trim(Str(Tutar))
DecimalPlace = InStr(Tutar, ".")
If DecimalPlace > 0 Then
cent = GetHundreds(Left(Mid(Tutar, DecimalPlace + 1) & "00", 2))
Tutar = Trim(Left(Tutar, DecimalPlace - 1))
End If
Count = 1
Do While Tutar <> ""
Temp = GetHundreds(Right(Tutar, 3))
If Temp <> "" Then kg = Temp & Place(Count) & kg
If Len(Tutar) > 3 Then
Tutar = Left(Tutar, Len(Tutar) - 3)
If Left(kg, 6) = " BirBin" Then kg = Mid(kg, 4, Len(kg))
If Left(kg, 6) = " BirYüz" Then kg = Mid(kg, 4, Len(kg))
Else
Tutar = ""
End If
Count = Count + 1
Loop
If Left(kg, 6) = " BirBin" Then kg = Mid(kg, 4, Len(kg))
If Left(kg, 6) = " BirYüz" Then kg = Mid(kg, 4, Len(kg))
Select Case cent
Case ""
cent = " sıfır " & alt_birim
Case " Bir"
cent = " bir " & alt_birim
Case Else
cent = " " & cent & " " & alt_birim
End Select
If Left(cent, 12) = " Bir Yüz " Then cent = " " & Mid(cent, 8, Len(cent))
yaz = kg & " Lira" & cent & " Kuruş"
tamam:
End Function
Function GetHundreds(ByVal Tutar)
Dim Result As String
If Val(Tutar) = 0 Then Exit Function
Tutar = Right("000" & Tutar, 3)
If Mid(Tutar, 1, 1) <> "0" Then
Result = GetDigit(Mid(Tutar, 1, 1)) & " Yüz"
End If
If Mid(Tutar, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(Tutar, 2))
Else
Result = Result & GetDigit(Mid(Tutar, 3))
End If
GetHundreds = Result
End Function
Function GetTens(TensText)
Dim Result As String
Result = ""
If Val(Left(TensText, 1)) = 1 Then
Select Case Val(TensText)
Case 10: Result = " On"
Case 11: Result = " Onbir"
Case 12: Result = " Oniki"
Case 13: Result = " Onüç"
Case 14: Result = " Ondört"
Case 15: Result = " Onbeş"
Case 16: Result = " Onaltı"
Case 17: Result = " Onyedi"
Case 18: Result = " Onsekiz"
Case 19: Result = " Ondokuz"
Case Else
End Select
Else
Select Case Val(Left(TensText, 1))
Case 2: Result = " Yirmi"
Case 3: Result = " Otuz"
Case 4: Result = " Kırk"
Case 5: Result = " Elli"
Case 6: Result = " Altmış"
Case 7: Result = " Yetmiş"
Case 8: Result = " Seksen"
Case 9: Result = " Doksan"
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1))
End If
GetTens = Result
End Function
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = " Bir"
Case 2: GetDigit = " İki"
Case 3: GetDigit = " Üç"
Case 4: GetDigit = " Dört"
Case 5: GetDigit = " Beş"
Case 6: GetDigit = " Altı"
Case 7: GetDigit = " Yedi"
Case 8: GetDigit = " Sekiz"
Case 9: GetDigit = " Dokuz"
Case Else: GetDigit = " "
End Select
End Function