excell rakamı yazıya çevirme

[Anonymous]

merhaba,
benim sorunum excellde yazdığım bir rakamı texte çeviremiyorum istiyorum.
Ör: rakamla (10) yazmışsam bunu yazı ile (on )olarak görmek istiyorum

şenay

[hizli]

ilk önce görünümden araclar menusunden visual basic acmalısın sonra
actıktan sonra visual basic editor acmalasın ve oradan kısyal yol cubugundan ıkıncı secenege tıklarsan yanı mouse yaklastırdıgında (insert userform) yazan yere oradan modul sectıkten sonra asagıda vermıs oldugum modulu onun ıcerısıne copy yap
Function Yaziyla$(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$
Yaziyla$ = s$
GoTo tamam
hata: Yaziyla$ = "Hata"
tamam:
End Function




bunu paste yaptıktan sonra makroyu tamamen kapat vede sonra visual basic kapat vede sonra eger rakkamı yazacagın yerın hemen yanındakı hucreye sunu yazacaksınız =yaziyla(hücreadı) ve de artık herhangı en buyuk sayıyı yaz hemencecık rakkamla yazacak simdilik bu kadar eger baska bır sorun varsa bana yazabılırsın tabı yada buraya yazman yeterlı
sevgılerımle

[Anonymous]

www.pcmagazine.com dan dosyayı direkt indirebilirsin yazmakla falan hiç uğraşma