Excel de Sayı ve Rakamları Yazıyla Yazdırma

Excel de Sayı ve Rakamları Yazıyla Yazdırma

Microsoft Excel de çok ihtiyaç duyulan bir konu ile karşınızdayız. Microsoft excel içinde herhangi bir hücreye yazılan sayıyı veya rakamları nasıl Yazıyla (okunuşu) yazdırabiliriz.

Bu işlem için Makro Kodlarını (VBA) kullanacağız.

İşlem Adımları:

1- Yeni excel Açın

2- Alt+F11 uşuna basarak Visual Basic Düzenleyici yi açın.

3- Sol tarafta (sayfa1,Sayfa2 yazan bölümde) Sağ tıklayın ve Insert –> Module seçeneğini tıklayınız.

4- Modul içine Aşağıdaki kodları aynen Yapıştırınız.

KODLAR *********
Public Function YAZIYACEVIR(Para_Tutar)
Dim Para_TutarStr As String
Dim ParaBirimi As String, ParaAltBirimi As String
HücreAdı = Para_Tutar.Address
If Para_Tutar = “” Then
YAZIYACEVIR = HücreAdı & ” Hücresine bir değer girmelisiniz !…”
Exit Function
End If
If Not IsNumeric(Para_Tutar) Then
YAZIYACEVIR = HücreAdı & ” Hücresine girilen değer, sayı değil !…”
Exit Function
End If
ParaStr = Format(Abs(Para_Tutar), “0.00”)
ParaBirimi = Left(ParaStr, Len(ParaStr) – 3)
ParaAltBirimi = Right(ParaStr, 2)
YAZIYACEVIR = IIf(Para_Tutar = 0, “Yalnız ” & Cevir(ParaBirimi) & ” TL “, “”) & IIf(Para_Tutar <> 0, “Yalnız “, “”) & IIf(Para_Tutar < 0, “Eksi (-) “, “”) & IIf(Para_Tutar <> 0, Cevir(ParaBirimi) & ” TL “, “”) & IIf(Val(ParaAltBirimi) <> 0, Cevir(ParaAltBirimi) & ” Kr.”, “”)
If ParaBirimi = 0 And ParaAltBirimi > 0 Then
YAZIYACEVIR = “Yalnız ” & Cevir(ParaAltBirimi) & ” Kr.”
If Para_Tutar < 0 And ParaAltBirimi > 0 Then
YAZIYACEVIR = “Yalnız Eksi (-) ” & Cevir(ParaAltBirimi) & ” Kr.”
End If
End If
End Function
Private Function Cevir(SayiStr As String) As String
Dim Rakam(15)
Dim c(3), Sonuc, e
Birler = Array(“”, “bir”, “iki”, “üç”, “dört”, “beş”, “altı”, “yedi”, “sekiz”, “dokuz”)
Onlar = Array(“”, “on”, “yirmi”, “otuz”, “kırk”, “elli”, “altmış”, “yetmiş”, “seksen”, “doksan”)
Binler = Array(“trilyon”, “milyar”, “milyon”, “bin”, “”)
SayiStr = String(15 – Len(SayiStr), “0”) + SayiStr
For i = 1 To 15
Rakam(i) = Val(Mid$(SayiStr, i, 1))
Next i
Sonuc = “”
For i = 0 To 4
c(1) = Rakam(i * 3 + 1)
c(2) = Rakam(i * 3 + 2)
c(3) = Rakam(i * 3 + 3)
If c(1) = 0 Then
e = “”
ElseIf c(1) = 1 Then
e = “yüz”
Else
e = Birler(c(1)) + “yüz”
End If
e = e + Onlar(c(2)) + Birler(c(3))
If e <> “” Then e = e + Binler(i)
If (i = 3) And (e = “birbin”) Then e = “bin”
Sonuc = Sonuc + e
Next i
If Sonuc = “” Then Sonuc = “Sıfır”
Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) – 1)
End Function

********KOD BİTİŞ

5- Daha sonra Excel ekranına geçerek =YaziyaCevir(A2) yazdığınızda A2 deki rakam veya sayı yazı olarak (Yalnız Bir TL Yetmişaltı Kr.) şekilde yazdığını göreceksiniz.

 

Bir cevap yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir