Sayıyı Yazıya Çevirme - Baskı Önizleme

Kod:
Option Explicit



Public Function SayiyiYaziyaCevir(Sayi As String, Optional Seviye As Integer = 0) As String

On Local Error Resume Next

Dim Ek As String, Donen As String



Donen = Choose((Mid(Sayi, Len(Sayi) - (Seviye * 3) - 2, 1)) + 1, "", "Yüz", "İkiYüz", "ÜçYüz", "DörtYüz", "BeşYüz", "AltıYüz", "YediYüz", "SekizYüz", "DokuzYüz")

Donen = Donen & Choose((Mid(Sayi, Len(Sayi) - (Seviye * 3) - 1, 1)) + 1, "", "On", "Yirmi", "Otuz", "Kırk", "Elli", "Altmış", "Yetmiş", "Seksen", "Doksan")

Donen = Donen & Choose((Mid(Sayi, Len(Sayi) - (Seviye * 3), 1)) + 1, "", "Bir", "İki", "Üç", "Dört", "Beş", "Altı", "Yedi", "Sekiz", "Dokuz")

 

If Donen <> "" Then Ek = Choose(Seviye + 1, "", "Bin", "Milyon", "Milyar", "Trilyon", "Katrilyon", "Katrilyar") 'Bildiğiniz sayıyla sınırlı

If Donen = "Bir" And Seviye = 1 Then Donen = "" 'BirBin çevrimini iptal etmek için

 

If Seviye * 3 + 3 < Len(Sayi) Then

Donen = SayiyiYaziyaCevir(Sayi, Seviye + 1) & Donen 'Sayinin cevrimi bitmemişse tekrar çağır

End If



SayiyiYaziyaCevir = Donen & Ek

End Function





Private Sub Command1_Click()

Label1.Caption = SayiyiYaziyaCevir(Text1.Text)

End Sub