WwW.FoRumSTylE.TuRKpr0foRuM.NET
Would you like to react to this message? Create an account in a few clicks or log in to continue.
WwW.FoRumSTylE.TuRKpr0foRuM.NET


 
AnasayfaPorTaLGaleriAramaLatest imagesKayıt OlGiriş yap
Arama
 
 

Sonuç :
 
Rechercher çıkıntı araştırma
En son konular
» kurtlar Vadisi Pusu Bölüm 13
Sayıyı Yazıya Çevirme Icon_minitimeSalı Haz. 30 2009, 12:06 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 12
Sayıyı Yazıya Çevirme Icon_minitimeSalı Haz. 30 2009, 12:03 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 11
Sayıyı Yazıya Çevirme Icon_minitimeSalı Haz. 30 2009, 11:49 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 10
Sayıyı Yazıya Çevirme Icon_minitimeSalı Haz. 30 2009, 11:47 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 09
Sayıyı Yazıya Çevirme Icon_minitimeSalı Haz. 30 2009, 11:36 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 08
Sayıyı Yazıya Çevirme Icon_minitimeSalı Haz. 30 2009, 11:29 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 07
Sayıyı Yazıya Çevirme Icon_minitimeSalı Haz. 30 2009, 11:28 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 06
Sayıyı Yazıya Çevirme Icon_minitimeSalı Haz. 30 2009, 11:27 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 05
Sayıyı Yazıya Çevirme Icon_minitimeC.tesi Haz. 27 2009, 20:18 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 04
Sayıyı Yazıya Çevirme Icon_minitimeC.tesi Haz. 27 2009, 20:15 tarafından yasakmc

Dost siteler
Kral Forumtr

 

 Sayıyı Yazıya Çevirme

Aşağa gitmek 
YazarMesaj
GÖZDE
Admin
Admin
GÖZDE


Kadın
Mesaj Sayısı : 1274
Yaş : 31
Nerden : sakarya
Kayıt tarihi : 05/05/08

Sayıyı Yazıya Çevirme Empty
MesajKonu: Sayıyı Yazıya Çevirme   Sayıyı Yazıya Çevirme Icon_minitimeC.tesi Şub. 07 2009, 17:12

Sayıyı Yazıya Çevirme

Bu konuda sayısız örnek mevcut aslında.

Bunlardan birini daha kısa ve kod tekniğinin anlaşılması açısından aşağıda ekledim.

Bundan başka uzun kuruşlu ifadelerde yuvarlama hataları çıkabiliyor. Aşağıda özel yuvarlama fonksiyonu "RoundA" bulunuyor.

Kod:

Function YTL(Para) As String
Dim tum$, tam$, kurus$, YTL_birim$, krs_birim$

tum = RoundA(Replace(Para, "-", ""), 2)
tam = Fix(tum)
kurus = RoundA(tum - tam, 2) * 100

YTL_birim = IIf(tam = 0, "", " YTL ")
krs_birim = IIf(kurus = 0, "", " YKR")

YTL = Ceviri(tam) & YTL_birim & Ceviri(kurus) & krs_birim
End Function

Private Function Ceviri(Say As String) As String
Dim arr() As Variant, c(1 To 3) As String, tmp As String, s As Byte

arr = Array("", "BİR", "İKİ", "ÜÇ", "DÖRT", "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ", _
"", "ON", "YİRMİ", "OTUZ", "KIRK", "ELLİ", "ALTMIŞ", "YETMİŞ", "SEKSEN", "DOKSAN", _
"", "YÜZ", "İKİYÜZ", "ÜÇYÜZ", "DÖRTYÜZ", "BEŞYÜZ", "ALTIYÜZ", "YEDİYÜZ", "SEKİZYÜZ", "DOKUZYÜZ", _
"TRİLYON", "MİLYAR", "MİLYON", "BİN", "")

Say = String$(15 - Len(Say), "0") + Say
For i = 1 To 15 Step 3
s = s + 1
c(1) = Mid$(Say, i, 1)
c(2) = Mid$(Say, i + 1, 1)
c(3) = Mid$(Say, i + 2, 1)
tmp = arr(20 + c(1)) & arr(10 + c(2)) & arr(c(3))
If tmp <> "" Then tmp = IIf(s = 4 And Trim$(tmp) = "BİR", "BİN", tmp & arr(30 + (s - 1)))
Ceviri = Ceviri & tmp
Next

Erase arr
Erase c
tmp = Empty
End Function

Private Function RoundA(Sayi, Optional Basamak As Long)
Kat& = 10 ^ Abs(Basamak)
If Basamak >= 0 Then RoundA = CDbl(FormatNumber(Left(Sayi, 30), Basamak))
If Basamak < 0 Then RoundA = CDbl(RoundA(FormatNumber(Left(Sayi, 30) / Kat), 0) * Kat)
End Function
Sayfa başına dön Aşağa gitmek
 
Sayıyı Yazıya Çevirme
Sayfa başına dön 
1 sayfadaki 1 sayfası
 Similar topics
-

Bu forumun müsaadesi var:Bu forumdaki mesajlara cevap veremezsiniz
WwW.FoRumSTylE.TuRKpr0foRuM.NET :: Teknoloji üzerine herşey :: Bilişim Teknolojileri :: Access-
Buraya geçin: