rakamı metne çevirme

[muddybank]

rakamı metne çevirmek istiyorum.bir kod buldum aşağıda gösteriyorum fakat benim istediğim biraz daha farklı benim yazdığım rakamlar tl yani 1234567 e formülü uyguladığım zaman almak istediğim sonuç BİR MİLYON İKİYÜZ OTUZ DÖRT BİN BEŞ YÜZ ATMIŞ YEDİ TL
yazacak virgüllü rakama uyguladığımızda ise örneğin 1234567.5 ise sonuç BİR MİLYON İKİYÜZ OTUZ DÖRT BİN BEŞ YÜZ ATMIŞ YEDİ TL ELLİ KURUŞ SONUCUNU VERECEK
yazılan rakam 1234567.50 isede BİR MİLYON İKİYÜZ OTUZ DÖRT BİN BEŞ YÜZ ATMIŞ YEDİ TL ELLİ KURUŞ sonucunu verecek.yardımcı olması bakımından rakamı metne çeviren bir kodu aşağıya ekliyorum.yardımlarınız için şimdiden çok teşekkür ederim

Function yaz$(sayi)
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v(15)
Dim c(3)

b$(0) = ""
b$(1) = "Bir"
b$(2) = "İki"
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(sayi)

If Left$(a$, 1) = " " Then pozitif = 1 Else pozitif = 0
a$ = Right$(a$, Len(a$) - 1)
For x = 1 To Len(a$)
If (Asc(Mid$(a$, x, 1)) > Asc("9")) Or (Asc(Mid$(a$, x, 1)) < Asc("0")) Then GoTo hata
Next x

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$

yaz$ = s$
GoTo tamam
hata: yaz$ = "Hata"
tamam:
End Function

 

[uzmanamele]

merhaba

bu işinizi görür mü?
sizin kodlarınızı incelemektense bende mevcut olan kodları vermek daha kolayıma geldi.

Function tl_yaz(sayi)
On Error Resume Next
Dim deg(3), s(3), deger(2)
a = Array("", "Bir", "İki", "Üç", "Dört", "Beş", "Altı", "Yedi", "Sekiz", "Dokuz")
b = Array("", "On", "Yirmi", "Otuz", "Kırk", "Elli", "Altmış", "Yetmiş", "Seksen", "Doksan")
c = Array("", "", "Bin", "Milyon", "Milyar", "Trilyon")
deger(1) = Int(sayi)
deger(2) = Round(sayi - deger(1), 2) * 100
If sayi = 0 Then son = "sıfır"
For g = 1 To 2
yazi = deger(g)
For d = 1 To Len(yazi) Step 3
e = e + 1
deg(1) = Mid(yazi, Len(yazi) - d - 1, 1)
deg(2) = Mid(yazi, Len(yazi) - d, 1)
deg(3) = Mid(yazi, Len(yazi) - d + 1, 1)
If deg(1) <> 0 Then s(1) = Replace(a(deg(1)) & "Yüz", "BirYüz", "Yüz")
s(2) = b(deg(2))
s(3) = a(deg(3)) & c(e)
If deg(1) + deg(2) + deg(3) = 0 Then s(3) = ""
son = s(1) & s(2) & s(3) & son
If Left(son, 6) = "BirBin" Then son = Replace(son, "BirBin", "Bin")
For f = 1 To 3
deg(f) = ""
s(f) = ""
Next: Next
If g = 1 And deger(1) <> 0 Then tl = son & " TürkLirası"
If g = 2 And deger(2) <> 0 Then kr = " " & son & " Kuruş"
son = ""
e = 0
Next
tl_yaz = tl & kr
End Function

 

[muddybank]

tşk

hocam teşekkür ederim yalnız formül ben de çalışmadı ad# hatası verdi
a1 hücresine 50 yazdım sonra =tl_yaz(a1) yadım olmadı
tabi bundan önce visual basic düzenleyicinin kod sayfasına sizin kodları kopyaladım.

acaba başka bir yere mi kopyalayacaktım?

 

[uzmanamele]

merhaba
yaklaşık 1 ay sonra geri dönüş yapmışsınız, ne güzel!

makro güvenlik seviyesini orta yapın, dosyayı açarken makroları etkinleştirin.

 

[muddybank]

#ad?

haklısın hocam biraz geç oldu.
dediklerini yaptım ad hatası vermeye devam ediyor.formülü tanımıyor bir türlü