arkadaşlar aşağıdaki kodları bu sayfadan aldım güzel çalışıyor da
çok küçük bir yerde sanırım bir şey unutulmuş.
oda 11.223 "onbirbinikiyüzyirmiüç bunda sorun yok
fakat
21.247 31.658 41.890 gibi "bir binli" (21binli, 31 binli, 41binli.....) sayılarda hata yapıyor yani 21.247=yirmi bin iki yüz kırk yedi....
31.658=otuzbin altıyüzellisekiz....gibi çok küçük bir hata yapıyor...
bunun hatasını ben bulamadım...sizlerden rica etsem bir göz atabilirmi?
saygılarımla
Function YazYTL(ByVal Sayi)
Dim Lira, Kurus, Temp
Dim Basamak, Say
ReDim Hane(9) As String
Hane(2) = " Bin "
Hane(3) = " Milyon "
Hane(4) = " Milyar "
Hane(5) = " Trilyon "
Sayi = Trim(Str(Sayi))
Basamak = InStr(Sayi, ".")
If Basamak > 0 Then
Kurus = Onlar(Left(Mid(Sayi, Basamak + 1) & "00", 2))
Sayi = Trim(Left(Sayi, Basamak - 1))
End If
Say = 1
Do While Sayi <> ""
Temp = Yuzler(Right(Sayi, 3))
If Temp <> "" Then Lira = Temp & Hane(Say) & Lira
If Len(Sayi) > 3 Then
Sayi = Left(Sayi, Len(Sayi) - 3)
Else
Sayi = ""
End If
Say = Say + 1
Loop
Select Case Lira
Case ""
Lira = "Sıfır YTL"
Case "Bir"
Lira = "Bir YTL"
Case Else
Lira = Lira & " YTL"
End Select
Lira = WorksheetFunction.Substitute(Lira, "Bir Bin", "Bin", 1)
Lira = WorksheetFunction.Substitute(Lira, "Bir Yüz", "Yüz", 1)
Select Case Kurus
Case ""
Kurus = " ve Sıfır Kuruş"
Case "One"
Kurus = " ve Bir Kuruş"
Case Else
Kurus = " ve " & Kurus & " Kuruş"
End Select
YazYTL = Lira & Kurus
End Function
'
Function Yuzler(ByVal Sayi)
Dim Result As String
If Val(Sayi) = 0 Then Exit Function
Sayi = Right("000" & Sayi, 3)
If Mid(Sayi, 1, 1) <> "0" Then
Result = Rakkam(Mid(Sayi, 1, 1)) & " Yüz "
End If
If Mid(Sayi, 2, 1) <> "0" Then
Result = Result & Onlar(Mid(Sayi, 2))
Else
Result = Result & Rakkam(Mid(Sayi, 3))
End If
Yuzler = Result
End Function
'
Function Onlar(OnlarBasamak)
Dim Result As String
Result = ""
If Val(Left(OnlarBasamak, 1)) = 1 Then
Select Case Val(OnlarBasamak)
Case 10: Result = "On"
Case 11: Result = "Onbir"
Case 12: Result = "Oniki"
Case 13: Result = "Onüç"
Case 14: Result = "Ondört"
Case 15: Result = "Onbeş"
Case 16: Result = "Onaltı"
Case 17: Result = "Onyedi"
Case 18: Result = "Onsekiz"
Case 19: Result = "Ondokuz"
Case Else
End Select
Else
Select Case Val(Left(OnlarBasamak, 1))
Case 2: Result = "Yirmi "
Case 3: Result = "Otuz "
Case 4: Result = "Kırk "
Case 5: Result = "Elli "
Case 6: Result = "Altmış "
Case 7: Result = "Yetmiş "
Case 8: Result = "Seksen "
Case 9: Result = "Doksan "
Case Else
End Select
Result = Result & Rakkam(Right(OnlarBasamak, 1))
End If
Onlar = Result
End Function
'
Function Rakkam(Deger)
Select Case Val(Deger)
Case 1: Rakkam = "Bir"
Case 2: Rakkam = "İki"
Case 3: Rakkam = "Üç"
Case 4: Rakkam = "Dört"
Case 5: Rakkam = "Beş"
Case 6: Rakkam = "Altı"
Case 7: Rakkam = "Yedi"
Case 8: Rakkam = "Sekiz"
Case 9: Rakkam = "Dokuz"
Case Else: Rakkam = ""
End Select
End Function
çok küçük bir yerde sanırım bir şey unutulmuş.
oda 11.223 "onbirbinikiyüzyirmiüç bunda sorun yok
fakat
21.247 31.658 41.890 gibi "bir binli" (21binli, 31 binli, 41binli.....) sayılarda hata yapıyor yani 21.247=yirmi bin iki yüz kırk yedi....
31.658=otuzbin altıyüzellisekiz....gibi çok küçük bir hata yapıyor...
bunun hatasını ben bulamadım...sizlerden rica etsem bir göz atabilirmi?
saygılarımla
Function YazYTL(ByVal Sayi)
Dim Lira, Kurus, Temp
Dim Basamak, Say
ReDim Hane(9) As String
Hane(2) = " Bin "
Hane(3) = " Milyon "
Hane(4) = " Milyar "
Hane(5) = " Trilyon "
Sayi = Trim(Str(Sayi))
Basamak = InStr(Sayi, ".")
If Basamak > 0 Then
Kurus = Onlar(Left(Mid(Sayi, Basamak + 1) & "00", 2))
Sayi = Trim(Left(Sayi, Basamak - 1))
End If
Say = 1
Do While Sayi <> ""
Temp = Yuzler(Right(Sayi, 3))
If Temp <> "" Then Lira = Temp & Hane(Say) & Lira
If Len(Sayi) > 3 Then
Sayi = Left(Sayi, Len(Sayi) - 3)
Else
Sayi = ""
End If
Say = Say + 1
Loop
Select Case Lira
Case ""
Lira = "Sıfır YTL"
Case "Bir"
Lira = "Bir YTL"
Case Else
Lira = Lira & " YTL"
End Select
Lira = WorksheetFunction.Substitute(Lira, "Bir Bin", "Bin", 1)
Lira = WorksheetFunction.Substitute(Lira, "Bir Yüz", "Yüz", 1)
Select Case Kurus
Case ""
Kurus = " ve Sıfır Kuruş"
Case "One"
Kurus = " ve Bir Kuruş"
Case Else
Kurus = " ve " & Kurus & " Kuruş"
End Select
YazYTL = Lira & Kurus
End Function
'
Function Yuzler(ByVal Sayi)
Dim Result As String
If Val(Sayi) = 0 Then Exit Function
Sayi = Right("000" & Sayi, 3)
If Mid(Sayi, 1, 1) <> "0" Then
Result = Rakkam(Mid(Sayi, 1, 1)) & " Yüz "
End If
If Mid(Sayi, 2, 1) <> "0" Then
Result = Result & Onlar(Mid(Sayi, 2))
Else
Result = Result & Rakkam(Mid(Sayi, 3))
End If
Yuzler = Result
End Function
'
Function Onlar(OnlarBasamak)
Dim Result As String
Result = ""
If Val(Left(OnlarBasamak, 1)) = 1 Then
Select Case Val(OnlarBasamak)
Case 10: Result = "On"
Case 11: Result = "Onbir"
Case 12: Result = "Oniki"
Case 13: Result = "Onüç"
Case 14: Result = "Ondört"
Case 15: Result = "Onbeş"
Case 16: Result = "Onaltı"
Case 17: Result = "Onyedi"
Case 18: Result = "Onsekiz"
Case 19: Result = "Ondokuz"
Case Else
End Select
Else
Select Case Val(Left(OnlarBasamak, 1))
Case 2: Result = "Yirmi "
Case 3: Result = "Otuz "
Case 4: Result = "Kırk "
Case 5: Result = "Elli "
Case 6: Result = "Altmış "
Case 7: Result = "Yetmiş "
Case 8: Result = "Seksen "
Case 9: Result = "Doksan "
Case Else
End Select
Result = Result & Rakkam(Right(OnlarBasamak, 1))
End If
Onlar = Result
End Function
'
Function Rakkam(Deger)
Select Case Val(Deger)
Case 1: Rakkam = "Bir"
Case 2: Rakkam = "İki"
Case 3: Rakkam = "Üç"
Case 4: Rakkam = "Dört"
Case 5: Rakkam = "Beş"
Case 6: Rakkam = "Altı"
Case 7: Rakkam = "Yedi"
Case 8: Rakkam = "Sekiz"
Case 9: Rakkam = "Dokuz"
Case Else: Rakkam = ""
End Select
End Function