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 = "birbin ") Then e = "bin "
Sonuc = Sonuc + e
Next i
If Sonuc = "" Then Sonuc = "0"
rcevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function
'---Bu fonksiyon kesirli de olsa verilen sayıyı, yazıya çevirir. Kullanımı: Excel tablosu
'---içindeki hücreye =Yaziyla(A1) şeklindedir. A1 içinde sayı bulunan hücreyi temsil eder.
'---Fonksiyon: Microsoft Excel, Access, Visual Basic ve Quick Basic programlarında çalışır
'---Programmed by Remzi Kuyugöz, Halkapınar Kaymakamlığı, Yazı İşleri Müd. 2005
Function Yaziyla(Sayi#)
Dim virgul2 As String
Dim cevap As String
Dim yazi As String
Dim Say As String
Dim uclu As String
Dim virgul As Integer
Dim o As Integer
Dim b As Integer
Dim x As Integer
Dim i As Integer
Dim y As Integer
Dim YTL As String
Dim YKR As String
If Sayi# = 0 Then Yaziyla = "Sıfır": Exit Function
Say = Str$(Sayi#)
virgul = InStr(1, Say, ".")
If virgul Then
'Aşağadaki satır 26,4 Yirmialtı YTL, KIRK YKR olarak okutur.
' (Yirmialtı YTL, DÖRT YKR olarak değil)
'İptal etmek isterseniz başına bir ' tek tırnak işareti koyunuz
If Len(Mid(Say, virgul + 1)) = 1 Then Say = Say + "0"
Say = Right$(Say, Len(Say) - virgul)
GoSub cevir
If cevap = "" Then YKR = ""
virgul2 = cevap + YKR
cevap = ""
Say = Str$(Sayi#)
Say = Left$(Say, virgul - 1)
End If
GoSub cevir
If cevap = "" Then YTL = ""
Yaziyla = cevap + YTL + virgul2
Exit Function
cevir:
x = Len(Say)
Say = String$(3 - (x - Int(x / 3) * 3), 48) + Say
x = Len(Say) / 3
For i = 1 To x
uclu = Mid$(Say, Len(Say) - i * 3 + 1, 3)
y = Val(Mid$(uclu, 1, 1))
o = Val(Mid$(uclu, 2, 1))
b = Val(Mid$(uclu, 3, 1))
yazi = ""
If y <> 0 Then
If y > 1 Then yazi = birler$
yazi = yazi + "Yüz "
End If
yazi = yazi + onlar$(o) + birler$(b)
If yazi <> "" Then
If LCase(yazi) = "bir" And i = 2 Then yazi = ""
cevap = yazi + basamak$(i) + cevap
End If
Next i
If Sayi# < 0 Then cevap = "-Eksi-" + cevap
Return
End Function
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.