SAYIYI YAZIYA ÇEVÝRME

[redne]

slm
excelde bir fatura sayfasý hazýrladým
Toplamýn karþýsýna gelen rakkamlarý yazýya dönüþtürebiliyorum fakat ben bu faturalarý yurtdýþýna kestiðim için hem türkçe hemde ingilizce olarak alt alta yazdýrmak istiyorum tabiiki türkçe yazýný sonunda tl ingilizce yazýnýn sonunda da € simge eklentisinin olmasýný istiyorum. bu mümkün mü ?

Cevaplarýnýz için þimdiden teþekkürler
Redne

[Hüseyin]

slm
excelde bir fatura sayfasý hazýrladým
Toplamýn karþýsýna gelen rakkamlarý yazýya dönüþtürebiliyorum fakat ben bu faturalarý yurtdýþýna kestiðim için hem türkçe hemde ingilizce olarak alt alta yazdýrmak istiyorum tabiiki türkçe yazýný sonunda tl ingilizce yazýnýn sonunda da € simge eklentisinin olmasýný istiyorum. bu mümkün mü ?

Cevaplarýnýz için þimdiden teþekkürler
Redne

Merhaba,
yazýya dönüþtürme iþlemini hangi yolla yapýyorsunuz? :?:

[redne]

slm
visual basic aþaðýdaki kodlarý yadým ve yazýný çýkmasý gereken hücreye =yaziyla (e54) yazdým
kod bildiðiniz gibi þöyle
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v(15)
Dim c(3)

Function yaziyla$(sayi)
b$(0) = ""
b$(1) = "BÝR"
b$(2) = "ÝKÝ"
b$(3) = "ÜÇ"
b$(4) = "DÃ?RT"
b$(5) = "BEÞ"
b$(6) = "ALTI"
b$(7) = "YEDÝ"
b$(8) = "SEKÝZ"
b$(9) = "DOKUZ"

y$(0) = ""
y$(1) = "ON"
y$(2) = "YÝRMÝ"
y$(3) = "OTUZ"
y$(4) = "KIRK"
y$(5) = "ELLÝ"
y$(6) = "ALTMIÞ"
y$(7) = "YETMÝÞ"
y$(8) = "SEKSEN"
y$(9) = "DOKSAN"

m$(0) = "TRÝLYON"
m$(1) = "MÝLYAR"
m$(2) = "MÝLYON"
m$(3) = "BÝN"
m$(4) = ""

a$ = Str(sayi)
If Left$(a$, 1) = " " Then pozitif = 1 Else pozitif = 0
a$ = Right$(a$, Len(a$) - 1)
For X = 1 To Len(a$)
If (Asc(Mid$(a$, X, 1)) > Asc("9")) Or (Asc(Mid$(a$, X, 1)) < Asc("0")) Then GoTo hata
Next X
If Len(a$) > 15 Then GoTo hata
a$ = String(15 - Len(a$), "0") + a$
For X = 1 To 15
v(X) = Val(Mid$(a$, X, 1))
Next X

s$ = ""
For X = 0 To 4
c(1) = v((X * 3) + 1)
c(2) = v((X * 3) + 2)
c(3) = v((X * 3) + 3)
If c(1) = 0 Then
e$ = ""
ElseIf c(1) = 1 Then
e$ = "YÜZ"
Else
e$ = b$(c(1)) + "YÜZ"
End If
e$ = e$ + y$(c(2)) + b$(c(3))
If e$ <> "" Then e$ = e$ + m$(X)
If (X = 3) And (e$ = "BÝRBÝN") Then e$ = "BÝN"
s$ = s$ + e$
Next X

If s$ = "" Then s$ = "SIFIR"
If pozitif = 0 Then s$ = "eksi" + s$
yaziyla$ = s$
GoTo tamam
hata: yaziyla$ = "hata"
tamam:
End Function


kolay gelsin
redne

[Hüseyin]

Ayný function kodunu kopyalayýp

function enyaziyla$(sayý) þeklinde tekrardan yazdýrýn ve týrnak içindeki türkçe sayýlarýn yerine ingilizcelerini yazýn.
Ýngilizce ile türkçe arasýnda diziliþ ayný, eðer almanca yazmak isteseydik o zaman sadece yazýlarý deðiþtirmek yetmeyecekti. Almancada okunuþta dizilim farklý oluyor.

Function enyaziyla$(sayi)
b$(0) = ""
b$(1) = "ONE"
b$(2) = "TWO"
.
.
.
þeklinde.

Türkçe yazmk istediðiniz hücreye =yazýyla(e54)&" TL" yazýn
Ýngilizce için bir alt satýra =enyazýyla(e54)&" €" yazýn.

Sonucu paylaþýrsanýz memnun olurum.

[uzaylý]

Merhaba,

Sn. Hüseyin hocamýn yazdýklarýna bir þey eklemek istiyorum. Ayný fonksiyonu ingilizce için kullanamayýz, çünkü ingilizce OnBir, Oniki gibi sayýlarýn karþýlýklarý Türkçedeki gibi deðildir. Bunun için daha önce güzel bir fonksiyon bulmuþtum. Aþaðýdaki fonksiyonu bir modul sayfasýna kopyalayýp
=SpellNumber(A1) þeklinde çalýþtýrabilirsiniz.
Option Explicit

'****************
' Main Function *
'****************
Function SpellNumber(ByVal MyNumber)

Dim Dollars, Cents, Temp
Dim DecimalPlace, Count

ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "

' String representation of amount
MyNumber = Trim(Str(MyNumber))

' Position of decimal place 0 if none
DecimalPlace = InStr(MyNumber, ".")
'Convert cents and set MyNumber to dollar amount
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If

Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop

Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select

Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select

SpellNumber = Dollars & Cents
End Function

'*******************************************
' Converts a number from 100-999 into text *
'*******************************************
Private Function GetHundreds(ByVal MyNumber)
Dim Result As String

If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)

'Convert the hundreds place
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If

'Convert the tens and ones place
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If

GetHundreds = Result
End Function

'*********************************************
' Converts a number from 10 to 99 into text. *
'*********************************************
Private Function GetTens(TensText)
Dim Result As String

Result = "" 'null out the temporary function value
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19
Select Case Val(TensText)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else ' If value between 20-99
Select Case Val(Left(TensText, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) 'Retrieve ones place
End If
GetTens = Result
End Function

'*******************************************
' Converts a number from 1 to 9 into text. *
'*******************************************
Private Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function

Kolay gelsin

[Hüseyin]

Merhaba @uzaylý,
kod için çok teþekkürler. :bravo:
11 ,12 olayý gözümden kaçmýþ. :mrgreen:

Rica etsem Makro örnekleri bölümünde bulunan türkçe kodun devamýna bunuda ingilizce versiyonu diye ekleyebilirmisiniz.

[redne]

slm,
hüseyin hocam ve uzaylý arkadaþým çok teþekkür ederim iþime çok yaradý.
Ayrýca ben iki dilin birden ayný anda kullanýlýp kullanýlamýyacaðýný merak ediyordum.çok teþekkür ederim verdiðiniz mesai için
redne

[ud123456]

Merhaba;

excel 2007 de düzenlediðim Faturanýn toplamýný Euro olarak Almanca yazýya çevirmek istiyorum.

Lütfen bu konuda yardýmýnýzý rica ediyorum.

[iaydin20]

Merhaba;

arkadaþlar bu yazýya çevirme iþini formulle yapmamýz mümkünmü acaba þimdiden teþekkür ederim...


:yardim:

[conari]

yazý ile yazma olaylarýný eklenti haline getirmiþtim.

xla dosyasýný eklenti olarak excel e göstererek, kullanýcý tanýmlý fonksiyonlarda
kullanabilirsiniz.
=Euro_yaz(250,2) Karþýlýðý / Two Hundred Fifty Euro And Twenty Cents

=YTL_yaz(250,2) / ÝKÝYÜZELLÝ YENÝ TÜRK LÝRASI YÝRMÝ KURUÞ

[daimi1]

Arkadaþlar kodlarý ekleyemedim. rica etsem ekteki excel dosyasýndaki kýsmý benim için düzenleyip gönderirmisiniz...

daimi.tavan@gmail.com

[Ýhsan Tank]

Arkadaþlar kodlarý ekleyemedim. rica etsem ekteki excel dosyasýndaki kýsmý benim için düzenleyip gönderirmisiniz...

daimi.tavan@gmail.com

merhaba
iki adet dosya ekliyorum biri sizin dosyanýz diðeri eklenti
eklenti olaný herhangi bir excel sayfasýndan
araçlar - eklentiler - gözat kýsmýna yapýþtýrýnýz.
=paracevir(hücre)

[Vedat Özer]

Yazýyla ilgili formda o kadar çok örnek varki araþtýrýrsanýz görürsünüz ben förmülünü yazým dosyanýza


iyi günler

[Ýhsan Tank]

buyrun bir örnek daha gönderiyorum
formül olarak hücreye giriniz
=ParaCevir(X56;"TL";"Kr")
module kopyalayýnýz
Function ParaCevir(Para, Optional PBirim = "Lira", Optional KBirim = "Kuruþ")
Dim ParaStr As String
Dim Lira As String, Kurus As String
If Not IsNumeric(Para) Then
ParaCevir = "GÝRÝLEN DEÐER SAYI DEÐÝL!"
Exit Function
End If
ParaStr = Format(Abs(Para), "0.00")
Lira = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " " & PBirim & " " & _
IIf(Val(Kurus) <> 0, Cevir(Kurus) & " " & KBirim & " ", "")
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

örnek dosya ektedir.

[MORLOG]

sonuncu çok iþime yaradý teþekkürler

[MORLOG]

Olmuyor yapamýyorum

[Vedat Özer]

Selamlar
Neyi Yapamýyonuz !

[MORLOG]

OOO VEDAT BEY HOÞ GELDÝNÝZ AÞAÐIDAKÝ LÝNKÝ TIKLAYABÝLÝRMÝSÝNÝZ EXCELDE FATURA KESMÝYE ÇALIÞIYORUM AMA ÞABLONU BÝR TÜRLÜ OTTUTURAMIYORUM ARKADAÞA TÞK EDERÝM YARDIMCI OLMAYA ÇALIÞTI AMA OLMADI BÝRTÜRLÜ SAYFAYA OTURMUYOR VE EN SONDA GENEL TOPLAMI YAZI OLARAK YALNIZ KISMINA YAZMASINI ÝSTÝYORUM ODA OLMUYOR FATURA KESMEM GEREK KESEMÝYORUM YAZIM ÇOK ÇÝRKÝN.:yardim::yardim:
http://www.excel.web.tr/showthread.php?t=84491

[CIRKINADAM]

arkadaþlar evde bu xla güzel yükledim ama iþ yerinde 2007 ingilizce kullanýyorum ve bir türlü ekleyemedim.
konu hakkýnda yardým edermisiniz.
tþk.

[mancubus]

xla dosyayý 2007'de açýn. xlam olarak save edin.

ofis düðmesi, save as, save as type, (açýlýr kutuda en altýn bir üstündeki) Excel Add-In (*.xlam)

[centirmen]

buyrun bir örnek daha gönderiyorum
formül olarak hücreye giriniz
=ParaCevir(X56;"TL";"Kr")

Function ParaCevir(Para, Optional PBirim = "Lira", Optional KBirim = "Kuruþ")
Dim ParaStr As String
Dim Lira As String, Kurus As String
If Not IsNumeric(Para) Then
ParaCevir = "GÝRÝLEN DEÐER SAYI DEÐÝL!"
Exit Function
End If
ParaStr = Format(Abs(Para), "0.00")
Lira = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " " & PBirim & " " & _
IIf(Val(Kurus) <> 0, Cevir(Kurus) & " " & KBirim & " ", "")
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

örnek dosya ektedir.


merhaba bu formül benimde iþime yaradý süper :) de
mesela (50,20) Elli tl yirmi kuruþ diyor
ben birleþik yazmasýný istiyorum ellitlyirmikuruþ bu þekil yazma þansýmýz var mý?

[mancubus]

aþaðýdaki kodu

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " " & PBirim & " " & _
IIf(Val(Kurus) <> 0, Cevir(Kurus) & " " & KBirim & " ", "")




þekline dönüþtürün.
ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & PBirim & _
IIf(Val(Kurus) <> 0, Cevir(Kurus) & KBirim & " ", "")

[centirmen]

eywalllah hocam elinize saðlýk :)

[mancubus]

rica ederim.

[halil_ibo]

arkadaþlar yardýmýnýza ihtiyacým var excelde hazýrlamýs olduðum ve bankaya tahsile vereceðim senetlerin bodrosunun yukarýdaki açýklama kýsmýnda otomatik olarak adetini ve meblaðýný yazdýrmak istiyorum. örneðini ekte gönderdim yardýmcý olursanýz sevinirim...

[Erdal]

Merhabalar
Eki inceleyiniz.