Kuruşlar için ek olarak aşağıdaki kodları kullanın
rakam.Text = Format(CDbl(rakam.Text), "########0.00")
yazi.Text = Yazıyla(Val(rakam.Text))
yazi = yazi + "lira"
If Right(rakam.Text, 2) = "00" Then
Exit Sub
End If

Select Case Mid(rakam.Text, Len(rakam.Text) - 1, 1)
Case 0
yazi = yazi + ""
Case 1
yazi = yazi + "on"
Case 2
yazi = yazi + "yirmi"
Case 3
yazi = yazi + "otuz"
Case 4
yazi = yazi + "kırk"
Case 5
yazi = yazi + "elli"
Case 6
yazi = yazi + "altmış"
Case 7
yazi = yazi + "yetmiş"
Case 8
yazi = yazi + "seksen"
Case 9
yazi = yazi + "doksan"
End Select

Select Case Mid(rakam.Text, Len(rakam.Text), 1)
Case 0
yazi = yazi + "kuruş"
Case 1
yazi = yazi + "birkuruş"
Case 2
yazi = yazi + "ikikuruş"
Case 3
yazi = yazi + "üçkuruş"
Case 4
yazi = yazi + "dörtkuruş"
Case 5
yazi = yazi + "beşkuruş"
Case 6
yazi = yazi + "altıkuruş"
Case 7
yazi = yazi + "yedikuruş"
Case 8
yazi = yazi + "sekizkuruş"
Case 9
yazi = yazi + "dokuzkuruş"
End Select

10089648 busayısı 10 milyon olarak okuyor kodlar hatalı onbin seksendokuztl 648 krs demesı lazım

insert module seçip yapıştır kullanırken de =yazıyla(a1) gibi a1 hücresinde ne varsa değeri yazıya çevirir =yazıyla() istediğiniz bir hücreye tanımlamalısınız

Function Yazıyla$(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$ = "Bir Bin ") Then e$ = "Bin "
s$ = s$ + e$
Next x
If s$ = "" Then s$ = "Sıfır"
If pozitif = 1 Then s$ = "Eksi" + s$
Yazıyla$ = s$
GoTo tamam
hata: Yazıyla$ = "Hata"
tamam:
End Function
Private Sub Command1_Click()
Dim myStr As String
Dim xPos As Integer
Dim yPos As Integer

myStr = Text1
xPos = InStr(1, myStr, ".") 'nokta ara
yPos = InStr(1, myStr, ",") 'virgul ara

If xPos = 0 Then 'sayi noktali degilse
If yPos = 0 Then 'sayi virgullu degilse
Text2.Text = Yazıyla(Text1.Text)
Else
Text2.Text = Yazıyla(Mid$(myStr, 1, yPos - 1)) & "Lira " & Yazıyla(Mid$(myStr, yPos + 1, Len(myStr))) & "Kuruş"
End If
Else
Text2.Text = Yazıyla(Mid$(myStr, 1, xPos - 1)) & "Lira " & Yazıyla(Mid$(myStr, xPos + 1, Len(myStr))) & "Kuruş"
End If
End Sub
' Bu projenin sahibinden özür dileyerek üzerinde biraz değişiklik yaptım. Noktalı sayıları da çevirilebilir hale getirdim. Ahmet SARI.

arkadaşlar ben yapamadım bunu tam anlatabilirmisiniz
bunu kullanılan bie excel dosyasını bana gönderebilirmisini

allah razı müthiş bir kod command 2de text ekleyince çalışıyor

arkadaşım bilgi için teşk ama bir türlü rakamı yazıya çevirmiyor altf11 visual basic ekliyorum ama olmuyor. yardımmmmm!