Merhaba arkadaşlar site süper...
Sy, Modalının hazırladığı kodları kullandım ama ufakbir hata var
1.232 Ytl (Birbinikiyüzotuziki Yeni Türk Lirası) olarak çeviriyi
eyer noktadan önce 1 varsa yazmaması gerekiyor birden büyük rakamları yazması gerekiyor
1.232 Ytl (Binikiyüzotuziki Yeni Türk Lirası) Olması gerekiyor
Kodlar:
Option Compare Database
Function YTL(sayi)
x = InStr(1, sayi, ",")
If x > 0 Then
Lira = yaz$(Mid(sayi, 1, x - 1)) & " YENI TÜRK LIRASI "
TempKurus = Mid(sayi, x + 1, 98)
If Len(TempKurus) = 1 Then TempKurus = TempKurus * 10
If Len(TempKurus) > 2 Then TempKurus = Mid(TempKurus, 1, 2)
Kurus = yaz$(TempKurus) & " YENI KURUS"
Else
Lira = yaz$(sayi) & " YENI TÜRK LIRASI "
End If
YTL = Lira & Kurus
End Function
'
Function yaz$(sayi)
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) = "BES"
b$(6) = "ALTI"
b$(7) = "YEDI"
b$(8) = "SEKIZ"
b$(9) = "DOKUZ"
y$(0) = ""
y$(1) = "ON"
y$(2) = "YIRMI"
y$(3) = "OTUZ"
y$(4) = "KIRK"
y$(5) = "ELLI"
y$(6) = "ALTMIS"
y$(7) = "YETMIS"
y$(8) = "SEKSEN"
y$(9) = "DOKSAN"
m$(0) = "TRILYON"
m$(1) = "MILYAR"
m$(2) = "MILYON"
m$(3) = "BIN"
m$(4) = ""
a$ = str(sayi)
If Left$(a$, 1) = "" Then pozitif = 1 Else pozitif = 0
a$ = Right$(a$, Len(a$) - 1)
For x = 1 To Len(a$)
If (Asc(Mid$(a$, x, 1)) > Asc("9")) Or (Asc(Mid$(a$, x, 1)) < Asc("0")) Then GoTo hata
Next x
If Len(a$) > 15 Then GoTo hata
a$ = String(15 - Len(a$), "0") + a$
For x = 1 To 15
v(x) = Val(Mid$(a$, x, 1))
Next x
a$ = ""
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$ = "BİRBİN") Then e$ = "BİN"
S$ = S$ + e$
Next x
If S$ = "" Then S$ = "SIFIR"
If pozitif = 0 Then S$ = "" + S$
yaz$ = S$
GoTo tamam
hata: yaz$ = "hata"
tamam:
End Function
Sy, Modalının hazırladığı kodları kullandım ama ufakbir hata var
1.232 Ytl (Birbinikiyüzotuziki Yeni Türk Lirası) olarak çeviriyi
eyer noktadan önce 1 varsa yazmaması gerekiyor birden büyük rakamları yazması gerekiyor
1.232 Ytl (Binikiyüzotuziki Yeni Türk Lirası) Olması gerekiyor
Kodlar:
Option Compare Database
Function YTL(sayi)
x = InStr(1, sayi, ",")
If x > 0 Then
Lira = yaz$(Mid(sayi, 1, x - 1)) & " YENI TÜRK LIRASI "
TempKurus = Mid(sayi, x + 1, 98)
If Len(TempKurus) = 1 Then TempKurus = TempKurus * 10
If Len(TempKurus) > 2 Then TempKurus = Mid(TempKurus, 1, 2)
Kurus = yaz$(TempKurus) & " YENI KURUS"
Else
Lira = yaz$(sayi) & " YENI TÜRK LIRASI "
End If
YTL = Lira & Kurus
End Function
'
Function yaz$(sayi)
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) = "BES"
b$(6) = "ALTI"
b$(7) = "YEDI"
b$(8) = "SEKIZ"
b$(9) = "DOKUZ"
y$(0) = ""
y$(1) = "ON"
y$(2) = "YIRMI"
y$(3) = "OTUZ"
y$(4) = "KIRK"
y$(5) = "ELLI"
y$(6) = "ALTMIS"
y$(7) = "YETMIS"
y$(8) = "SEKSEN"
y$(9) = "DOKSAN"
m$(0) = "TRILYON"
m$(1) = "MILYAR"
m$(2) = "MILYON"
m$(3) = "BIN"
m$(4) = ""
a$ = str(sayi)
If Left$(a$, 1) = "" Then pozitif = 1 Else pozitif = 0
a$ = Right$(a$, Len(a$) - 1)
For x = 1 To Len(a$)
If (Asc(Mid$(a$, x, 1)) > Asc("9")) Or (Asc(Mid$(a$, x, 1)) < Asc("0")) Then GoTo hata
Next x
If Len(a$) > 15 Then GoTo hata
a$ = String(15 - Len(a$), "0") + a$
For x = 1 To 15
v(x) = Val(Mid$(a$, x, 1))
Next x
a$ = ""
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$ = "BİRBİN") Then e$ = "BİN"
S$ = S$ + e$
Next x
If S$ = "" Then S$ = "SIFIR"
If pozitif = 0 Then S$ = "" + S$
yaz$ = S$
GoTo tamam
hata: yaz$ = "hata"
tamam:
End Function
