Function Yaziyacevir(ByVal Tutar As Double) As String
Dim Sonuc As String
Dim TL As Double, Kurus As Long
If Tutar < 0 Then
Yaziyacevir = "Eksi " & Yaziyacevir(Abs(Tutar))
Exit Function
End If
TL = Int(Tutar)
Kurus = Round((Tutar - TL) * 100, 0)
Sonuc = TamSayiYazi(TL) & " TL"
If Kurus > 0 Then
Sonuc = Sonuc & " " & TamSayiYazi(Kurus) & " Kuruş"
End If
Yaziyacevir = Application.WorksheetFunction.Trim(Sonuc)
End Function
Private Function TamSayiYazi(ByVal Sayi As Double) As String
Dim Birler, Onlar, Basamak
Dim Grup As Integer
Dim Metin As String
Birler = Array("", "Bir", "İki", "Üç", "Dört", "Beş", "Altı", "Yedi", "Sekiz", "Dokuz")
Onlar = Array("", "", "Yirmi", "Otuz", "Kırk", "Elli", "Altmış", "Yetmiş", "Seksen", "Doksan")
Basamak = Array("", "Bin", "Milyon", "Milyar", "Trilyon")
If Sayi = 0 Then
TamSayiYazi = "Sıfır"
Exit Function
End If
Grup = 0
Do While Sayi > 0
Dim Uc As Integer
Uc = Sayi Mod 1000
If Uc <> 0 Then
Dim Parca As String
Parca = UcBasamak(Uc, Birler, Onlar)
If Grup = 1 And Uc = 1 Then
Parca = "Bin "
ElseIf Grup > 0 Then
Parca = Parca & Basamak(Grup) & " "
End If
Metin = Parca & Metin
End If
Sayi = Int(Sayi / 1000)
Grup = Grup + 1
Loop
TamSayiYazi = Metin
End Function
Private Function UcBasamak(ByVal Sayi As Integer, Birler, Onlar) As String
Dim YuzlerBas As Integer, OnlarBas As Integer, BirlerBas As Integer
Dim Metin As String
YuzlerBas = Int(Sayi / 100)
OnlarBas = Int((Sayi Mod 100) / 10)
BirlerBas = Sayi Mod 10
If YuzlerBas > 0 Then
If YuzlerBas = 1 Then
Metin = "Yüz "
Else
Metin = Birler(YuzlerBas) & " Yüz "
End If
End If
If OnlarBas > 0 Then
Metin = Metin & Onlar(OnlarBas) & " "
End If
If BirlerBas > 0 Then
Metin = Metin & Birler(BirlerBas) & " "
End If
UcBasamak = Metin
End Function
