Ytl & Usd & Eur Sayiyi Yaziya Çevİrme

[BULENT061]

'YazYTL(Para) , YazEUR(Para) , YazUSD(Para) foksiyon sayıyı yazıya çevirme

Public Function Yaz(Para)
Dim ParaStr As String
Dim TL As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
TL = Left(ParaStr, Len(ParaStr) - 3)
Yaz = IIf(Para < 0, "Eksi ", "") & Cevir(TL)
Exit Function
SayiDegil:
Yaz = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function
Public Function YazTL(Para)
Dim ParaStr As String
Dim TL As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
TL = Left(ParaStr, Len(ParaStr) - 3)
YazTL = IIf(Para < 0, "Eksi ", "") & Cevir(TL) & " TL"
Exit Function
SayiDegil:
YazTL = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function

Public Function YazYTL(Para)
Dim ParaStr As String
Dim YTL As String, Kurus As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
YTL = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
If YTL = 0 Then
YazYTL = IIf(Para < 0, "Eksi ", "") & Cevir(Kurus) & " KURUŞ"
Else
If Kurus = 0 Then
YazYTL = IIf(Para < 0, "Eksi ", "") & Cevir(YTL) & "-YTL."
Else
YazYTL = IIf(Para < 0, "Eksi ", "") & Cevir(YTL) & "-YTL." & Cevir(Kurus) & "-YENİ KURUŞ."
End If
End If
Exit Function
SayiDegil:
YazYTL = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function
Public Function YazEUR(Para)
Dim ParaStr As String
Dim EUR As String, Kurus As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
EUR = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
If EUR = 0 Then
YazEUR = IIf(Para < 0, "Eksi ", "") & Cevir(Kurus) & " SENT"
Else
If Kurus = 0 Then
YazEUR = IIf(Para < 0, "Eksi ", "") & Cevir(EUR) & "-EUR."
Else
YazEUR = IIf(Para < 0, "Eksi ", "") & Cevir(EUR) & "-EUR." & Cevir(Kurus) & "-SENT."
End If
End If
Exit Function
SayiDegil:
YazEUR = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function
Public Function YazUSD(Para)
Dim ParaStr As String
Dim USD As String, Kurus As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
USD = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
If USD = 0 Then
YazUSD = IIf(Para < 0, "Eksi ", "") & Cevir(Kurus) & " SENT"
Else
If Kurus = 0 Then
YazUSD = IIf(Para < 0, "Eksi ", "") & Cevir(USD) & "-USD."
Else
YazUSD = IIf(Para < 0, "Eksi ", "") & Cevir(USD) & "-USD." & Cevir(Kurus) & "-SENT."
End If
End If
Exit Function
SayiDegil:
YazUSD = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function

Private Function Cevir(SayiStr As String) As String
Dim Rakam(15)
Dim c(3), Sonuc, e
Birler = Array("", "BİR", "İKİ", "ÜÇ", "DÖRT", "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ")
Onlar = Array("", "ON", "YİRMİ", "OTUZ", "KIRK", "ELLİ", "ALTMIŞ", "YETMİŞ", "SEKSEN", "DOKSAN")
Binler = Array("TRİLYON", "MİLYAR", "MİLYON", "BİN", "")
SayiStr = String(15 - Len(SayiStr), "0") + SayiStr
For i = 1 To 15
Rakam(i) = Val(Mid$(SayiStr, i, 1))
Next i
Sonuc = ""
For i = 0 To 4
c(1) = Rakam(i * 3 + 1)
c(2) = Rakam(i * 3 + 2)
c(3) = Rakam(i * 3 + 3)
If c(1) = 0 Then
e = ""
ElseIf c(1) = 1 Then
e = "YÜZ"
Else
e = Birler(c(1)) + "YÜZ"
End If
e = e + Onlar(c(2)) + Birler(c(3))
If e <> "" Then e = e + Binler(i)
If (i = 3) And (e = "BİRBİN") Then e = "BİN"
Sonuc = Sonuc + e
Next i
If Sonuc = "" Then Sonuc = "00"
Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function

 

[avcetin79]

merhaba,
modüle olduğu gibi kopyaladım fakat bir yerde hata yapıyorum galiba, 1286,44 eur yu
BİRbinikiyüzseksenaltı-USD.Kırkdört-SENT. olarak yazıya çeviriyor. acaba ne yapmalıyım.
yardımınızı rica ederim.

 

[suleyman242]

merhaba,
modüle olduğu gibi kopyaladım fakat bir yerde hata yapıyorum galiba, 1286,44 eur yu
BİRbinikiyüzseksenaltı-USD.Kırkdört-SENT. olarak yazıya çeviriyor. acaba ne yapmalıyım.
yardımınızı rica ederim.

Normal çalışıyor ama