Rakamı metne çevirmede problem

[bybilgin]

slm arklar aşağıdaki kodla rakamı metne çeviriyorum

Public Function LiraCevir(Lira)
Dim LiraStr As String
Dim YTL As String, Kurus As String
If Not IsNumeric(Lira) Then GoTo Sayiolmali
LiraStr = Format(Abs(Lira), "0.00")
YTL = Left(LiraStr, Len(LiraStr) - 3)
Kurus = Right(LiraStr, 2)
LiraCevir = IIf(Lira < 0, "", "") & Cevir(YTL) & " YTL " & Cevir(Kurus) & " Kr"
Exit Function
Sayiolmali:
LiraCevir = "Lütfen sayı girin"
End Function

Private Function Cevir(SayiStr As String) As String
Dim Rakam(15)
Dim c(3), Sonuc, e
Birler = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
Onlar = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
Binler = Array("trilyon ", "milyar ", "milyon ", "bin ", "")
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 = "birbin ") Then e = "bin "
Sonuc = Sonuc + e
Next i
If Sonuc = "" Then Sonuc = "sıfır"
Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function

ancak rakam eksilere düşünce başında eksi yazmasını istiyorum nasıl ekleme yapabilirim

 

[İdris SERDAR]

Public Function YAZIYACEVIR(Para_Tutar)

Dim Para_TutarStr As String
Dim ParaBirimi As String, ParaAltBirimi As String

HücreAdı = Para_Tutar.Address

If Para_Tutar = "" Then
YAZIYACEVIR = HücreAdı & " Hücresine bir değer girmelisiniz !..."
Exit Function
End If

If Not IsNumeric(Para_Tutar) Then
YAZIYACEVIR = HücreAdı & " Hücresine girilen değer, sayı değil !..."
Exit Function
End If

ParaStr = Format(Abs(Para_Tutar), "0.00")
ParaBirimi = Left(ParaStr, Len(ParaStr) - 3)
ParaAltBirimi = Right(ParaStr, 2)

YAZIYACEVIR = IIf(Para_Tutar = 0, "" & Cevir(ParaBirimi) & " YTL ", "") & _
IIf(Para_Tutar <> 0, "", "") & _
IIf(Para_Tutar < 0, "Eksi (-) ", "") & _
IIf(Para_Tutar <> 0, Cevir(ParaBirimi) & " YTL ", "") & _
IIf(Val(ParaAltBirimi) <> 0, Cevir(ParaAltBirimi) & " YKr.", "")

If ParaBirimi = 0 And ParaAltBirimi > 0 Then
YAZIYACEVIR = "" & Cevir(ParaAltBirimi) & " YKr."

If Para_Tutar < 0 And ParaAltBirimi > 0 Then
YAZIYACEVIR = "Eksi (-) " & Cevir(ParaAltBirimi) & " YKr."

End If

End If

End Function

Private Function Cevir(SayiStr As String) As String

Dim Rakam(15)
Dim c(3), Sonuc, e

Birler = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
Onlar = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
Binler = Array("trilyon", "milyar", "milyon", "bin", "")

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 = "birbin") Then e = "bin"
Sonuc = Sonuc + e
Next i

If Sonuc = "" Then Sonuc = "Sıfır"

Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function

Bunu deneyin.

 

[bybilgin]

Merhabalar

Sn. yurttas Çok Sağolun Tam İstediğim gibi Bi Fonksiyon tesekkür ederim