SAYIYI YAZIYA ÇEVİRME

[redne]

SAYIYI YAZIYA ÇEVÝRME

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]

Re: SAYIYI YAZIYA ÇEVÝRME

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]

YAZIYA ÇEVÝRME

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]

Sayıyı Almanca Euro cinsinden yazıya çevirmek

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]

Faturaki yazı ile yazan kısmı

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

 

[CIRKINADAM1]

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)