Arkadaşlar bu modülün YTL ilk çıktığında tarafımdan yeni paraya göre Dolar ve Cent'li örneğinden düzeltilmiş ve kuruş hanesinde sıfır değeri varsa "O kuruş" yazmaması sağlanmış halini kullanıyorum. Modülü aşağıda veriyorum. Özellikle kuruş hanesindeki "Sıfır" ifadesinin nasıl engellendiğine bakarak aynı şeyi TL tarafında da yapabilirsiniz. Böylece "Sıfır YeniTl" ifadesi de yerini "" ifadesine terkeder. Daha önce eklenen örnek üzerindeki çalışamaya eski modül yerine bu modülü ekledim. Koddan anlamayan arkadaşlar da ordan inceler.
Kolay gelsin.
KODUN AÇIK HALİ:
Public Function ParaCevir(Para)
Dim ParaStr As String
Dim YTL As String, Kurus As String
Dim sifirsa As String
Dim ve 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 Cevir(Kurus) = "SIFIR" Then sifirsa = "" Else sifirsa = Cevir(Kurus) & " YENİ KURUŞ"
If Cevir(Kurus) = "SIFIR" Then ve = "" Else ve = " ve "
ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(YTL) & " YENİTL " & ve & sifirsa
Exit Function
SayiDegil:
ParaCevir = "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 = "SIFIR"
Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function
mdDENEME.rar
(Dosya Boyutu: 25,28 KB | İndirme Sayısı: 133)
İnadına, ille de Accesstr.net...
Cevapla