sayıyı yazıya çeviren kod ile alakalı

[sahinler64]

baya uzun zaman önce yazılmış olan bir kod var ve ben bunu kullanmak istiyorum ama bir türlü beceremedim.şimdi ben bu kodu excel içinde bir makro şeklinde kaydedeyim diyorum ama olmuyor.bu konuda rica etsem nasıl yapacağım konusunda bana yardımcı olurmusunuz....aslında belirtmiş "Bunu yapmak için aşağıdaki kodu bir module içine kopyalayın ve A2 ye =yaz(A1) yazın. A1 deki rakımı her değiştirdiğinizde A2 de bunun yazı ile yazılmış şeklini göreceksiniz." diye ama yapamadım.kusura bakmayın yardım rica ediyorum...

Merhaba,
Makro soru-cevap bölümüne gelen bir soru üzerine @genesis isimli üyemizin sunduğu çözümün örnek bir çalışma olarak burada da yer alması gerektiğini düşündüm.

A1 hücresine bir rakam yazıyorsunuz ve A2 de de bunu yazıyla yazdırmak istiyorsunuz:
örnek ;
A1 -> 256
A2 -> İKİYÜZELLİALTI

Bunu yapmak için aşağıdaki kodu bir module içine kopyalayın ve A2 ye =yaz(A1) yazın. A1 deki rakımı her değiştirdiğinizde A2 de bunun yazı ile yazılmış şeklini göreceksiniz.

Function yaz$(sayi) 
Dim b$(9) 
Dim y$(9) 
Dim m$(4) 
Dim v$(15) 
Dim c$(3) 
b$(0) = "" 
b$(1) = "BİR" 
b$(2) = "İKİ" 
b$(3) = "ÜÇ" 
b$(4) = "DÖRT" 
b$(5) = "BEŞ" 
b$(6) = "ALTI" 
b$(7) = "YEDİ" 
b$(8) = "SEKİZ" 
b$(9) = "DOKUZ" 
y$(0) = "" 
y$(1) = "ON" 
y$(2) = "YİRMİ" 
y$(3) = "OTUZ" 
y$(4) = "KIRK" 
y$(5) = "ELLİ" 
y$(6) = "ALTMIŞ" 
y$(7) = "YETMİŞ" 
y$(8) = "SEKSEN" 
y$(9) = "DOKSAN" 
m$(0) = "TRILYON" 
m$(1) = "MİLYAR" 
m$(2) = "MİLYON" 
m$(3) = "BİN" 
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 
a$ = "" 
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$ = "BİRBİN") Then e$ = "BİN" 
s$ = s$ + e$ 
Next x 
If s$ = "" Then s$ = "SIFIR" 
If pozitif = 0 Then s$ = "" + s$ 
yaz$ = s$ 
GoTo tamam 
hata: yaz$ = "hata" 
tamam: 
End Function

Teşekkürler @genesis.
:hey:

yazının orjinali ( http://www.excel.web.tr/f116/rakam-yazi-ile-yazd-rma-t651.html )
aslında bir adet zip uzantılı dosya varmış zamanında ama şimdi yok.yani indiremedim. "ytl2_267.zip" adında bir dosya

 

[Orion1]

Bunda bir hata yok.Dosyanızı yollayın bakalım.

 

[sahinler64]

kardeş hızlı cevap için çok saol ama ben işte dosya oluşturamıyorum.makro oluştur dediğimde hata veriyor.nerede yanlışlık var anlayamadım.rica etsem siz düzenleyim dosya şeklinde koyma şansınız varmı.
tabi aaaa çok oluyorsunuz artık demeyin.
şimdiden çok teşekkür ediyorum...

 

[Orion1]

kardeş hızlı cevap için çok saol ama ben işte dosya oluşturamıyorum.makro oluştur dediğimde hata veriyor.nerede yanlışlık var anlayamadım.rica etsem siz düzenleyim dosya şeklinde koyma şansınız varmı.
tabi aaaa çok oluyorsunuz artık demeyin.
şimdiden çok teşekkür ediyorum...

Bu bir fonksiyondur.Makro olouştur ile yapılmaz.F11 e basın vbe açılacaktır.Oradan insert module seçin.Açılan modüle bu fonksiyonu yapıştırın.
Dosya ekte.