MyDesign | Kod Arivi - Anasayfaya Dn   No banner in farm
Anasayfa Aratr Forum Gelimi Arama Siteniz in En Hit erikler RSS erik Ekle Scriptler Destekleyenler Kadromuz Reklam letiim Giri Sayfas Yap  Sk Kullanlanlara Ekle
Bu Kategorinin En Yeni Kodlar:


Bu Kategorinin En ok Grntlenen Kodlar:






Arama:
Gelimi Arama


No banner in farm



En ok Grntlenen Kodlar:


ye Girii:
 ye Ol



Anasayfa > VisualBasic > Kodlar

Rakamı Yazıya Çevirme

Metin kutusuna girilen sayıyı yazıyla yazar

Kategori : VisualBasic
Gnderen : LonG
Telif :
Tarih : 19 Temmuz 2005
rnek Dosya : �ndir
Okunma Says : 41817
Puan
: 8,9 / 10 (29 Oy)
Puan Verin :
Google Bookmarks  del.icio.us  Digg  Yahoo! MyWeb  Windows Live  Furl
 
 
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$ = "BirBin") 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()
Text2.Text = Yazıyla(Text1.Text)
End Sub
 
 

Rakamı Yazıya Çevirme iin yazlan yorumlar

Hikmet durmaz  { 19 Nisan 2016 }
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

hikmet  { 22 Ocak 2015 }
10089648 busayısı 10 milyon olarak okuyor kodlar hatalı onbin seksendokuztl 648 krs demesı lazım

Cengiz Öz  { 22 Eylül 2013 }
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

Ahmet SARI  { 24 Nisan 2013 }
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

samet   { 20 Mayıs 2009 }
allah razı müthiş bir kod command 2de text ekleyince çalışıyor

HAKAN HAYALOĞLU   { 31 Ekim 2008 }
arkadaşım bilgi için teşk ama bir türlü rakamı yazıya çevirmiyor altf11 visual basic ekliyorum ama olmuyor. yardımmmmm!

Yorum ekleyin

Anasayfa > VisualBasic > Kodlar > Rakamı Yazıya Çevirme
Kategoriler:


Forum:



Balantlar:



    En Son Yorumlanan erikler:


    Murat Yavuz | Site Haritas | Gizlilik Bildirimi | 34.204.191.31 | 0,14 Saniye
    © Copyright 2004-2019 MyDesign | Kod Arivi. Tm Haklar Sakldr.
    MyDesign | Kod Arivi, en iyi grnm iin, 1024x768 ve zeri znrlk tavsiye eder.