AccessTr.neT

dosyayı göremedim acaba eklemeyi mi unuttunuz. ben mi göremedim...

(01/08/2013, 00:34)salihkk yazdı: [ -> ]dosyayı göremedim acaba eklemeyi mi unuttunuz. ben mi göremedim...

Eskisin kaldırıp revize edilmiş halini koydum.

çok teşekkür ederim elinize emeğinize sağlık..

merhabalar tekrar. size göndermiş olduğum hafta sonu için ekders çizelgesinde TL işaretini kaldıramadım. normalde ders saati olması gerekiyor ya " 780 ders saati okutulmuştur" şeklinde ama orada TL çıkıyor. onu kaldırmamız gerekiyor.... teşekkürler şimdiden..

Aşağıdaki kodu Modül içerisine yapıştır. Sonra boş bir hücrede =yazıyla(hücre adresi) yaz

Function Yaziyla(Sayi#)
Dim virgul2 As String
Dim cevap As String
Dim yazi As String
Dim Say As String
Dim uclu As String
Dim virgul As Integer
Dim o As Integer
Dim b As Integer
Dim x As Integer
Dim i As Integer
Dim y As Integer
Dim YTL As String
Dim YKR As String

If Sayi# = 0 Then Yaziyla = "Sıfır": Exit Function

ReDim birler$(10), onlar$(10), basamak$(5)

birler$(0) = "": birler$(1) = "bir"
birler$(2) = "iki": birler$(3) = "üç"
birler$(4) = "dört": birler$(5) = "beş"
birler$(6) = "altı": birler$(7) = "yedi"
birler$(8) = "sekiz": birler$(9) = "dokuz"

onlar$(0) = "": onlar$(1) = "on"
onlar$(2) = "yirmi": onlar$(3) = "otuz"
onlar$(4) = "kırk": onlar$(5) = "elli"
onlar$(6) = "altmış": onlar$(7) = "yetmiş"
onlar$(8) = "seksen": onlar$(9) = "doksan"

basamak$(1) = "": basamak$(2) = "bin"
basamak$(3) = "milyon": basamak$(4) = "milyar"
basamak$(5) = "trilyon"

virgul2 = ""
cevap = ""

'AŞAĞIDAKİ 2 SATIRDAKİ ÇİFT TIRNAK İÇERİĞİNİ DEĞİŞTİREREK
'VEYA ÇİFT TIRNAĞIN ARASINI SİLEREK "" VEYA "," GİBİ
'İSTEĞİNİZ SONUCUN ÇIKMASINI SAĞLAYABİLİRSİNİZ.


Say = Str$(Sayi#)
virgul = InStr(1, Say, ".")
If virgul Then

'Aşağadaki satır 26,4 Yirmialtı YTL, KIRK YKR olarak okutur.
' (Yirmialtı YTL, DÖRT YKR olarak değil)
'İptal etmek isterseniz başına bir ' tek tırnak işareti koyunuz
If Len(Mid(Say, virgul + 1)) = 1 Then Say = Say + "0"

Say = Right$(Say, Len(Say) - virgul)
GoSub cevir



Say = Str$(Sayi#)
Say = Left$(Say, virgul - 1)
End If
GoSub cevir

Yaziyla = cevap + 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 LCase(yazi) = "bir" And i = 2 Then yazi = ""
cevap = yazi + basamak$(i) + cevap
End If
Next i
If Sayi# < 0 Then cevap = "-Eksi-" + cevap
Return
End Function

ya yapamadım dosya ekte duruyor rica etsem yapabilir misiniz...