sayıyı yazıya çevirme problemi!

[attila52]

:yardim:
arkadaşlar hepinize kolay gelsin aranıza yeni katıldım ama bu işle uğraşıyorum access benim için önemli fakat tabiki bilginin sınırı yok paylaşmak en güzeli ve benimde sizlerin yardımına ihtiyacım var .

aşağıdaki yazılı kodu başka bir bascıc ocx dosyasından access e uyarladım
enson usercontrol read ve write özelliklerinde birkaç değişiklik yaptım ve access e uyarladım fakat bu benim işimi yarım gördü yani eksiklik var ve tamamlamak istiyorum. Hata şu kuruş hanesini çeviremiyor düz rakamı yani 5.000,00 yada 5.225,00 gibi rakamı çeviriyor kuruşu çeviremiyor 5.225,25 ise bunu çeviremiyor .

ben hatamı biliyorum fakat basamak değerleri ve basamak sayılarını sıralamada ve birleştirmede eksik işlemim var fakat çözümü bulamadım.
yardımcı olabilecek arkadaş varsa sevinirim . kolay gelsin


Option Explicit
'SAY.OCX erdogan yildiz
Dim yazi, sayi
Function yaziya_cevir(S) As String
Dim sayi As String
sayi = S
Dim max_basamak_say

max_basamak_say = 18 '18 basamaklı yani katrilyon, dahada artırılabilir.
ReDim birler(10), onlar(10), binler(max_basamak_say / 3), bas(3)
birler = Array("", "BİR", "İKİ", "ÜÇ", "DÖRT", "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ")
onlar = Array("", "ON", "YİRMİ", "OTUZ", "KIRK", "ELLİ", "ALTMIŞ", "YETMİŞ", "SEKSEN", "DOKSAN")
'eğer 18 basamaktan daha fazla kullanacaksanız katrilyondan önce 0 basamakları da ekleyin.
binler = Array("KATRİLYON", "TİRİLYON", "MİLYAR", "MİLYON", "BİN", "")
Dim I, uz, sonuc, arasonuc
uz = Len(sayi)
'Sayının kullanılmayan basamaklarını sıfırla doldur
sayi = String(max_basamak_say - uz, "0") + sayi
For I = 0 To max_basamak_say / 3 - 1
'sayıyı üçerli basamaklar halinde ele al
bas(1) = Mid(sayi, (I * 3) + 1, 1) 'üçlü basamaktaki birinci sayı yani yüzler basamağı.
bas(2) = Mid(sayi, (I * 3) + 2, 1) 'üçlü basamaktaki ikinci.yani onlar
bas(3) = Mid(sayi, (I * 3) + 3, 1) 'üçlü basamaktaki üçüncü.yani birler
If bas(1) = 0 Then
arasonuc = "" 'yüzler basamağı boş
Else
If bas(1) = 1 Then
arasonuc = "YÜZ" 'yüzler basamağında 1 varsa 1 yüz olmaz sadece yüz
Else
arasonuc = birler(bas(1)) + "YÜZ" 'yüzler basamağındaki sayi ve yüz ikiyüz gibi.
End If
End If
'yüzler+onlar+birler basamağını birleştir
arasonuc = arasonuc + onlar(bas(2)) + birler(bas(3))
'basamaktaki değer oluşmadıysa yani 000 şeklindeyse binler basamağını ekle.
If arasonuc <> "" Then arasonuc = arasonuc + binler(I)
'birbin olmaz
If (I > 1) And (arasonuc = "BİRBİN") Then arasonuc = "BİN"
sonuc = sonuc + arasonuc + ""
Next
If sonuc = "" Then sonuc = "SIFIR"
yaziya_cevir = sonuc & ". YTL"
End Function
Public Property Get sayı() As Variant
sayı = sayi
End Property

Public Property Let sayı(ByVal vNewValue As Variant)
yazi = yaziya_cevir(vNewValue)
sayi = vNewValue
End Property
Public Property Get yazı() As Variant
yazı = yazi
End Property
Public Property Let yazı(ByVal vNewValue As Variant)
yazı = yazi
End Property
Private Sub UserControl_ReadProperties(PropBag As Property)
yazi = PropBag.Properties("Yazı", yazi)
sayi = PropBag.Properties("Sayı", sayi)
End Sub
Private Sub UserControl_WriteProperties(PropBag As Property)
Call PropBag.Properties("Sayı", sayi)
Call PropBag.Properties("Yazı", yazi)
End Sub

 

[modalı]

Sayın atilla52,

Forumun bir kenarında olması gerekiyor. Ama herkes araştırma yapmaktan üşeniyor. belki bu konuyla ilgili forumda 15 tane başlık var.

Her neyse aşağıdaki fonksiyonu kullanın.

Function YTL(sayi)
    x = InStr(1, sayi, ",")
    If x > 0 Then
        Lira = yaz$(Mid(sayi, 1, x - 1)) & " YENI TÜRK LIRASI "
        TempKurus = Mid(sayi, x + 1, 98)
        If Len(TempKurus) = 1 Then TempKurus = TempKurus * 10
        If Len(TempKurus) > 2 Then TempKurus = Mid(TempKurus, 1, 2)
        Kurus = yaz$(TempKurus) & "  YENI KURUS"
    Else
        Lira = yaz$(sayi) & " YENI TÜRK LIRASI "
    End If
    YTL = Lira & Kurus
End Function
'
Function yaz$(sayi)
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v$(15)
Dim c$(3)
b$(0) = ""
b$(1) = "BIR"
b$(2) = "IKI"
b$(3) = "ÜÇ"
b$(4) = "DÖRT"
b$(5) = "BES"
b$(6) = "ALTI"
b$(7) = "YEDI"
b$(8) = "SEKIZ"
b$(9) = "DOKUZ"
y$(0) = ""
y$(1) = "ON"
y$(2) = "YIRMI"
y$(3) = "OTUZ"
y$(4) = "KIRK"
y$(5) = "ELLI"
y$(6) = "ALTMIS"
y$(7) = "YETMIS"
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
a$ = ""
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$ = "BİRBİN") Then e$ = "BİN"
s$ = s$ + e$
Next x
If s$ = "" Then s$ = "SIFIR"
If pozitif = 0 Then s$ = "" + s$
yaz$ = s$
GoTo tamam
hata: yaz$ = "hata"
tamam:
End Function

 

[illede0]

eline sa&#287;l&#305;k