Almanca yazdırma

P

pcman

Katılım
23 Kasım 2007
Mesajlar
245
Excel Vers. ve Dili
2003
Merhaba Arkadaşlar yazıya çeviren kodlarda ufakbir değişiklik yapmam gerekiyor.

Kod: 
Option Compare Database

Function Euro2(sayi)
    x = InStr(1, sayi, ",")
    If x > 0 Then
        Lira = yaz$(Mid(sayi, 1, x - 1)) & " Euro "
        TempKurus = Mid(sayi, x + 1, 98)
        If Len(TempKurus) = 1 Then TempKurus = TempKurus * 10
        If Len(TempKurus) > 2 Then TempKurus = Mid(TempKurus, 1, 2)
        Kurus = yaz$(TempKurus) & "  Cent"
    Else
        Lira = yaz$(sayi) & " Euro "
    End If
    Euro2 = Lira & Kurus
End Function
'
Function yaz$(sayi)
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v$(15)
Dim c$(3)
b$(0) = ""
b$(1) = "EİN"
b$(2) = "ZWEI"
b$(3) = "DREI"
b$(4) = "VIER"
b$(5) = "FÜNF"
b$(6) = "SECHS"
b$(7) = "SIEBEN"
b$(8) = "ACHT"
b$(9) = "NEUN"
y$(0) = ""
y$(1) = "ZEHN"
y$(2) = "ZWANZIG"
y$(3) = "DREIZIG"
y$(4) = "VIERIG"
y$(5) = "FÜNFZIG"
y$(6) = "SECHZIG"
y$(7) = "SIEBZIG"
y$(8) = "ACHTZIG"
y$(9) = "NEUNZIG"
m$(0) = "TRILYON"
m$(1) = "MILYAR"
m$(2) = "MILYON"
m$(3) = "TAUSEND"
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
a$ = ""
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$ = "HUNDERT"
Else
E$ = b$(c(1)) + "HUNDERT"
End If
E$ = E$ + y$(c(2)) + b$(c(3))
If E$ <> "" Then E$ = E$ + m$(x)
If (x = 3) And (E$ = "BIRBIN") Then E$ = "BIN"
s$ = s$ + E$
Next x
If s$ = "" Then s$ = "SIFIR"
If pozitif = 0 Then s$ = "" + s$
yaz$ = s$
GoTo tamam
hata: yaz$ = "hata"
tamam:
End Function


Burda dikkatinizi çekmiştir sayıyı almanca yazdırıyorum
ama almancada birler ve onlar basamağının yerdeğiştirmesi gerekiyor türkçedeki gibi değil

türkçe yazıya çevirde

1234 olduğunda binikiyüzotuzdört yzıyor almanca olunca binikiyüzdörtotuz olması gerekiyor

yukardada dediğim gibi sadece onlar ve birler yerdeğiştirecek
 
Taruz

Taruz

Katılım
18 Nisan 2007
Mesajlar
2,053
Excel Vers. ve Dili
Access 2019
Merhaba..


Fonksiyonun ilgili yerlerini değiştirirseniz istediğiniz gibi birler, onlardan önce gelir..


Kod: 
Option Compare Database
[COLOR=red].........[/COLOR]
[COLOR=red]............[/COLOR]
[COLOR=red]......[/COLOR]
 
End If
E$ = E$ + [COLOR=red]b[/COLOR]$(c([COLOR=red]3[/COLOR])) + [COLOR=red]y[/COLOR]$(c([COLOR=red]2[/COLOR]))
If E$ <> "" Then E$ = E$ + m$(x)
[COLOR=red].........[/COLOR]
[COLOR=red]............[/COLOR]
[COLOR=red]......[/COLOR]
End Function


EİNTAUSENDZWEIHUNDERTVIERDREIZIG Euro.. ;)
 
P

pcman

Katılım
23 Kasım 2007
Mesajlar
245
Excel Vers. ve Dili
2003
Sn Taruz &#199;ok Te&#351;ekk&#252;r ederim Ufak bir ricam daha olucak araya Und Yazmam&#305;z laz&#305;m

1234 = binikiy&#252;z Und D&#246;rtOtuz

&#351;eklinde onlar ve birler yerde&#287;i&#351;tikten sonra birlerin ba&#351;&#305;na Und Gelmesi laz&#305;m
 
Taruz

Taruz

Katılım
18 Nisan 2007
Mesajlar
2,053
Excel Vers. ve Dili
Access 2019
Merhaba..

Kod: 
[COLOR=blue]......[/COLOR]
[COLOR=blue]........[/COLOR]
[COLOR=blue]......[/COLOR]
Else
E$ = b$(c(1)) + "HUNDERT [COLOR=red]Und[/COLOR] "
End If
[COLOR=black]E$ = E$ + b$(c(3)) + y$(c(2))[/COLOR]
If E$ <> "" Then E$ = E$ + m$(x)
[COLOR=blue].........[/COLOR]
[COLOR=blue]............[/COLOR]
[COLOR=blue]......[/COLOR]
End Function
İlgili yeri değiştirin..
 
P

pcman

Katılım
23 Kasım 2007
Mesajlar
245
Excel Vers. ve Dili
2003
Yüz

galiba Son Değişiklik

Kod: 
Option Compare Database

Function Euro2(sayi)
    x = InStr(1, sayi, ",")
    If x > 0 Then
        Lira = yaz$(Mid(sayi, 1, x - 1)) & " Euro "
        TempKurus = Mid(sayi, x + 1, 98)
        If Len(TempKurus) = 1 Then TempKurus = TempKurus * 10
        If Len(TempKurus) > 2 Then TempKurus = Mid(TempKurus, 1, 2)
        Kurus = yaz$(TempKurus) & "  Cent"
    Else
        Lira = yaz$(sayi) & " Euro "
    End If
    Euro2 = Lira & Kurus
End Function
'
Function yaz$(sayi)
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v$(15)
Dim c$(3)
b$(0) = ""
b$(1) = "EİN"
b$(2) = "ZWEI"
b$(3) = "DREI"
b$(4) = "VIER"
b$(5) = "FÜNF"
b$(6) = "SECHS"
b$(7) = "SIEBEN"
b$(8) = "ACHT"
b$(9) = "NEUN"
y$(0) = ""
y$(1) = "UNDZEHN"
y$(2) = "UNDZWANZIG"
y$(3) = "UNDDREIZIG"
y$(4) = "UNDVIERZIG"
y$(5) = "UNDFÜNFZIG"
y$(6) = "UNDSECHZIG"
y$(7) = "UNDSIEBZIG"
y$(8) = "UNDACHTZIG"
y$(9) = "UNDNEUNZIG"
m$(0) = "TRILYON"
m$(1) = "MILYAR"
m$(2) = "MILYON"
m$(3) = "TAUSEND"
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
a$ = ""
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$ = "HUNDERT"
Else
E$ = b$(c(1)) + "HUNDERT"
End If
E$ = E$ + b$(c(3)) + y$(c(2))
If E$ <> "" Then E$ = E$ + m$(x)
[COLOR="Red"]If E$ = "HUNDERT" Then E$ = "EİNHUNDERT"[/COLOR]
s$ = s$ + E$
Next x
If s$ = "" Then s$ = "SIFIR"
If pozitif = 0 Then s$ = "" + s$
yaz$ = s$
GoTo tamam
hata: yaz$ = "hata"
tamam:
End Function
Burda Taruz Arkadaşımın Yardımıyla Und Bağlacını yerleştirdim ama bu almanlar çok ters adamlar..

1123 olduğunda binyüzyirmiüç diyoruz almanlarda Birbinbiryüz yani sadece yüz olduğunda başına bir geliyor ikiyüz olduğunda sistem başına iki koyuyor...
şu anki kodlar birbin diyor ama biryüz demiyor sadece yüz olduğunda yüz yazıyor

If E$ = "HUNDERT" Then E$ = "EİNHUNDERT" ben bunu yaptım ama olmadı
 
Son düzenleme:
P

pcman

Katılım
23 Kasım 2007
Mesajlar
245
Excel Vers. ve Dili
2003
Almanca Yazıya çevirme

Kod: 
Option Compare Database

Function Euro2(sayi)
    x = InStr(1, sayi, ",")
    If x > 0 Then
        Lira = yaz$(Mid(sayi, 1, x - 1)) & " Euro "
        TempKurus = Mid(sayi, x + 1, 98)
        If Len(TempKurus) = 1 Then TempKurus = TempKurus * 10
        If Len(TempKurus) > 2 Then TempKurus = Mid(TempKurus, 1, 2)
        Kurus = yaz$(TempKurus) & "  Cent"
    Else
        Lira = yaz$(sayi) & " Euro "
    End If
    Euro2 = Lira & Kurus
End Function
'
Function yaz$(sayi)
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v$(15)
Dim c$(3)
b$(0) = ""
b$(1) = "EİN"
b$(2) = "ZWEI"
b$(3) = "DREI"
b$(4) = "VIER"
b$(5) = "FÜNF"
b$(6) = "SECHS"
b$(7) = "SIEBEN"
b$(8) = "ACHT"
b$(9) = "NEUN"
y$(0) = ""
y$(1) = "UNDZEHN"
y$(2) = "UNDZWANZIG"
y$(3) = "UNDDREIZIG"
y$(4) = "UNDVIERZIG"
y$(5) = "UNDFÜNFZIG"
y$(6) = "UNDSECHZIG"
y$(7) = "UNDSIEBZIG"
y$(8) = "UNDACHTZIG"
y$(9) = "UNDNEUNZIG"
m$(0) = "TRILYON"
m$(1) = "MILYAR"
m$(2) = "MILYON"
m$(3) = "TAUSEND"
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
a$ = ""
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$ = "EİNHUNDERT"
Else
E$ = b$(c(1)) + "HUNDERT"
End If
E$ = E$ + b$(c(3)) + y$(c(2))
If E$ <> "" Then E$ = E$ + m$(x)
s$ = s$ + E$
Next x
If s$ = "" Then s$ = "SIFIR"
If pozitif = 0 Then s$ = "" + s$
yaz$ = s$
GoTo tamam
hata: yaz$ = "hata"
tamam:
End Function
Taruz Arkadaşıma Teşekkür Ederim
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
bu kullanım doğru mu? merak ettim de
40 için UNDVIERZIG Euro yazıyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst