ID :
1937
ISLEM :
sayıyı rakama kuruşlu çevirmek
MAKRO KODU :
Function ParaCevir(para As Double)
If Not IsNumeric(sayi) Then GoTo hata
If (para - Int(para)) = 0 Then
paracevir= cevir(para)
Else
tamsayi = cevir(Int(para))
ondalik = cevir((para - Int(para)) * 100)
ondalik = LCase(Mid(ondalik, 1, 1)) + Mid(ondalik, 2, Len(ondalik) - 1)
paracevir = tamsayi + "virgül" + ondalik
End If
GoTo tamam
hata:
paracevir = "Hata"
tamam:
End Function
Private Function cevir(sayi As Double)
Dim b(9) As String
Dim y(9) As String
Dim m(4) As String
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(Round(sayi, 0))
If Left(a, 1) = " " Then pozitif = 1 Else pozitif = 0
a = Right(a, Len(a) - 1)
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
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
cevir = UCase(Mid(s, 1, 1)) + Mid(s, 2, Len(s) - 1)
End Function
exit sub
Hata:
cevir="HATA"
end function -