Yazıya Çevir (Ama farklı)

[balca]

Merhaba;

Aşağıdaki kodlar ile YTL,YKR yazdığım rakamı yazıya çevirebiliyorum
Yaptığımız yazışmalarda metin içinde önce rakam ile ardından yazı ile yazıyoruz.
Aşağıdaki kodlar ile rakamı yazıya dökebilmek için rakamı 2 kez yazmak zorunda kalıyorum
yani;

Sayın Ahmet Er'e ödenmek üzere 756,83 Y/YEDİYÜZELLİALTI YTL SEKSENÜÇ YKR hesaba
alacak geçiniz.

Yapmak istediğim ise ben burada 756,83 yazıp makroyu çalıştırdığımda 756,83 kalacak yanına
yazı ile yazacak.. Bu yapılabilir mi?

Kullandığım kodlar;
Sub YazYTL()

MyNum = Selection
Selection = Yaz_YTL(MyNum)
Selection.Range.Case = wdUpperCase
End Sub


Function Yaz_YTL(Para, Optional PBirim = "YTL", Optional KBirim = "Ykr")
Dim ParaStr As String
Dim YTL As String, Kurus As String

If Not IsNumeric(Para) Then
Yaz_YTL = "GİRİLEN DEÐER SAYI DEÐİL!"
Exit Function
End If

ParaStr = Format(Abs(Para), "0.00")

YTL = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)

Yaz_YTL = IIf(Para < 0, "Eksi ", "") & Cevir(YTL) & " " & PBirim & " " & _
IIf(Val(Kurus) <> 0, Cevir(Kurus) & " " & KBirim & " ", "")
End Function

Private Function Cevir(SayiStr As String) As String
Dim Rakam(15)
Dim c(3), Sonuc, e

Birler = Array("", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
Onlar = Array("", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
Binler = Array("trilyon", "milyar", "milyon", "bin", "")

SayiStr = String(15 - Len(SayiStr), "0") + SayiStr

For i = 1 To 15
Rakam(i) = Val(Mid$(SayiStr, i, 1))
Next i

Sonuc = ""
For i = 0 To 4
c(1) = Rakam(i * 3 + 1)
c(2) = Rakam(i * 3 + 2)
c(3) = Rakam(i * 3 + 3)
If c(1) = 0 Then
e = ""
ElseIf c(1) = 1 Then
e = "yüz"
Else
e = Birler(c(1)) + "yüz"
End If
e = e + Onlar(c(2)) + Birler(c(3))
If e <> "" Then e = e + Binler(i)
If (i = 3) And (e = "birbin") Then e = "bin"
Sonuc = Sonuc + e
Next i

If Sonuc = "" Then Sonuc = "Sıfır"

Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function

 

[Levent Menteşoğlu]

Aşağıdaki linki inceleyin.

http://www.excel.web.tr/viewtopic.php?t=3435

 

[isakarakus]

sn @leventm'in verdiği linkteki dosyada
yaz ytl fonksiyonunun

Selection =YTL(Selection)

satırını

Selection = Selection & " YTL/" & YTL(Selection)

olarak değiştir

 

[balca]

Tekrar Merhaba;

Ã?nerdiğiniz linki inceledim Sayın Raider'in YazYTL3.zip dosyasını indirdim
Sayın İsa Karakuş'un önerdiği düzeltmeyi yaptım Sayın Raider'in dosyasında gayet güzel çalıştı
amacım bütün word dosyalarında çalışmasıydı o yüzden linki inceleyerek bütün word
dosyalarını kapatarak alt+f11 ile yeni modüle uyguladım ama burada çalışmadı.

Herhalde yukarıdaki kodlarda yapılacak düzeltmeyle olmayacak bu iş.. :?

 

[veyselemre]

aşağıdaki şekilde ekleme yapın

Yaz_YTL = IIf(Para < 0, "Eksi ", "") & Cevir(YTL) & " " & PBirim & " " & _
IIf(Val(Kurus) <> 0, Cevir(Kurus) & " " & KBirim & " ", "")
Yaz_YTL = Para & "Y/" & Yaz_YTL

End Function

 

[Haluk]

Bütün MS Word dokümanlarında çalışması için, aynı mesajda konuyu anlatmıştım.

http://www.excel.web.tr/viewtopic.php?p=16029#16029

Oradakileri uyguladınız mı ?

 

[balca]

Sayın Raider;

Linkte anlattığınız şekilde yapıyorum.

Bütün word dökümanlarında çalışması için yukarıda vermiş olduğum kodları zaten kullanıyorum o kodların silinmesi mi gerekli tekrar deneyeceğim

EK: Tamam düşündüğüm gibi düzeldi.. Hepinizie teşekkürler. :hihoho: