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.
kamer { 23 Haziran 2011 }
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!