WwW.FoRumSTylE.TuRKpr0foRuM.NET


 
AnasayfaPorTaLTakvimGaleriSSSAramaKayıt OlGiriş yap
Arama
 
 

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

» kurtlar Vadisi Pusu Bölüm 12
Salı Haz. 30 2009, 12:03 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 11
Salı Haz. 30 2009, 11:49 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 10
Salı Haz. 30 2009, 11:47 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 09
Salı Haz. 30 2009, 11:36 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 08
Salı Haz. 30 2009, 11:29 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 07
Salı Haz. 30 2009, 11:28 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 06
Salı Haz. 30 2009, 11:27 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 05
C.tesi Haz. 27 2009, 20:18 tarafından yasakmc

» kurtlar Vadisi Pusu Bölüm 04
C.tesi Haz. 27 2009, 20:15 tarafından yasakmc

Dost siteler
Kral Forumtr

Paylaş | 
 

 Sayıyı Yazıya Çevirme

Önceki başlık Sonraki başlık Aşağa gitmek 
YazarMesaj
GÖZDE
Admin
Admin
avatar

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

MesajKonu: Sayıyı Yazıya Çevirme   C.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
Kullanıcı profilini gör
 
Sayıyı Yazıya Çevirme
Önceki başlık Sonraki başlık Sayfa başına dön 
1 sayfadaki 1 sayfası
 Similar topics
-
» Yazının Altını ve Üstünü Çizmek !
» kişisel ileti yazıları
» Vadideki Zambak ~ Balzac
» At savur at sevdayı bir yere fırlat Bitti sayıp acıyı kaldır öyle yat......
» Volkan Konak Ayvalık Konseri

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: