Rakamı yazıya çevirme

[Mesafe]

Formda konuyla ilgili pek çok çözüm buldum. Dosyamda makro ile başka işlemlerde yaptığım için makrolu bir çözümü dosyama uyarladım ancak Bin ile başlayan rakamları yazıya çevirirken başına Bir koyuyor.
Makrodaki bu hata düzeltilebilir mi ?

 

[halit3]

Formda konuyla ilgili pek çok çözüm buldum. Dosyamda makro ile başka işlemlerde yaptığım için makrolu bir çözümü dosyama uyarladım ancak Bin ile başlayan rakamları yazıya çevirirken başına Bir koyuyor.
Makrodaki bu hata düzeltilebilir mi ?

Bununla ilgili sitede birçok uygulama var bu kodu tam olarak bu siteden nerden aldınız tam adresini verinde oradada düzeltelim.


Bu kodu denermisiniz.

Function Yaziyla(sayi#)
Dim virgul2 As String, cevap As String, yazi As String, say As String, uclu As String
Dim virgul As Integer, o As Integer, b As Integer, X As Integer, i As Integer, y As Integer
Dim TL As String, KR As String
 
If sayi# = 0 Then Yaziyla = "": Exit Function
 
ReDim birler$(10), onlar$(10), Basamak$(5)
 
birler$(0) = "":        onlar$(0) = "":        Basamak$(1) = "":
birler$(1) = "bir":     onlar$(1) = "on":      Basamak$(2) = "bin"
birler$(2) = "iki":     onlar$(2) = "yirmi":   Basamak$(3) = "milyon":
birler$(3) = "üç":      onlar$(3) = "otuz":    Basamak$(4) = "milyar"
birler$(4) = "dört":    onlar$(4) = "kırk":    Basamak$(5) = "trilyon"
birler$(5) = "beş":     onlar$(5) = "elli"
birler$(6) = "altı":    onlar$(6) = "altmış":
birler$(7) = "yedi":    onlar$(7) = "yetmiş"
birler$(8) = "sekiz":   onlar$(8) = "seksen":
birler$(9) = "dokuz":   onlar$(9) = "doksan"
 
 
virgul2 = "": cevap = "": TL = ".TL.": KR = ".Krş."
say = Str$(sayi#): virgul = InStr(1, say, ".")
If virgul Then
If Len(Mid(say, virgul + 1)) = 1 Then say = say + "0"
say = Right$(say, Len(say) - virgul)
GoSub cevir
 
If cevap = "" Then KR = ""
virgul2 = cevap + KR
cevap = ""
say = Left$(Str$(sayi#), virgul - 1)
End If
GoSub cevir
If cevap = "" Then TL = ""
Yaziyla = WorksheetFunction.Proper(cevap) + TL + WorksheetFunction.Proper(virgul2)
Exit Function
cevir:
X = Len(say)
say = String$(3 - (X - Int(X / 3) * 3), 48) + say
X = Len(say) / 3
For i = 1 To X
uclu = Mid$(say, Len(say) - i * 3 + 1, 3)
y = Val(Mid$(uclu, 1, 1))
o = Val(Mid$(uclu, 2, 1))
b = Val(Mid$(uclu, 3, 1))
yazi = ""
If y <> 0 Then
If y > 1 Then yazi = birler$(y)
yazi = yazi + "yüz"
End If
 
yazi = yazi + onlar$(o) + birler$(b)
If yazi <> "" Then
If yazi = "bir" And i = 2 Then yazi = ""
cevap = yazi + Basamak$(i) + cevap
End If
Next i
If sayi# < 0 Then
cevap = "-Eksi-" + WorksheetFunction.Proper(cevap)
 
End If
Return
End Function

 

[Mesafe]

Sn. Halit3 ilgilendiğiniz için teşekkür ederim. Kodu sanıyorum aşağıdaki linkten çok önce bir gün lazım olur diye kaydetmiştim.
http://www.excel.web.tr/f116/rakamy-yazi-ile-yazdyrma-t651/sayfa6.html
ama şimdi tekrar kontrol ettim benim gönderdiğim örnekteki gibi bir hata vermiyor. Sanırım ben kodu büyük harfe çevirirken bir hata yapmışım.