TL çevirme..

[xcoll]

Arkadaşlar Lütfen Yardım edin ben makınada yazdıgım rakamları TL Kr ile yaziyla yazsın...

ama söyle yazsın...

örneğin 12.345,12

Onikibin üçyüzkırkbeş TL oniki Kr diye yazsın bende bir makro var ama

onda

onikibinüçyüzkırkbeş ...TL oniki Kr yazıyor yanı baş harfler buyuk değil ben o makroda değişiklil yapabılırmıyıım yapabılır ısem nasıl yapacagım makro benede acıp değiştirecegım yerı soylersenız değiştirebılırım ...

tşk ederım.

 

[1Al2Ver]

Arkadaşlar Lütfen Yardım edin ben makınada yazdıgım rakamları TL Kr ile yaziyla yazsın...

ama söyle yazsın...

örneğin 12.345,12

Onikibin üçyüzkırkbeş TL oniki Kr diye yazsın bende bir makro var ama

onda

onikibinüçyüzkırkbeş ...TL oniki Kr yazıyor yanı baş harfler buyuk değil ben o makroda değişiklil yapabılırmıyıım yapabılır ısem nasıl yapacagım makro benede acıp değiştirecegım yerı soylersenız değiştirebılırım ...

tşk ederım.

Sayın xcoll,

Dosyanız ektedir, aslında makroyu yazsaydınız sizin makro üzerinde değişiklik olabilirdi sanırım,

 

[xcoll]

hocam bunu makro dosyası degıl benım makro dosyasınıda acamıyorum nasıl acacıhımı anlatırsan acar buraya yazarm.

 

[xcoll]

birde şöyle bişey buldum nette YTL için ben buradakı YTL yazan yerleri değiştirip TL yazarsan nasıl makro olarak kayıt edecegım ....

-----------------------------------
Sub YTL()

End Sub
Function YeniTL(sayi, Optional tür As Byte = 0)
'Rakamı yeni türk lirası türünden belirt
'
'Makro S Şahin tarafından kaydedildi
'Stil =0 YTL ve YKR
' 1 Yalnız YTL
' 2 Tam sayı ise yalnız YTL
Dim tam
Dim küsur As Byte
Dim syazi As String

If IsNumeric(sayi) And Len(Format(sayi)) < 16 Then
sayi = Int(sayi * 100) / 100
If sayi < 0 Then
syazi = "Eksi "
sayi = Abs(sayi)
End If
tam = Int(sayi)
küsur = (sayi - tam) * 100
syazi = syazi & yçevir(tam) & " YTL "
If tür = 0 Or (tür = 2 And küsur <> 0) Then
syazi = syazi & yçevir(küsur) & " YKR"
End If
Else
syazi = "Hata"
End If
YeniTL = syazi
End Function

Function yçevir(csayi)
Dim birler, onlar, bsayi
Dim rakamlar(1 To 15) As Byte
Dim yazi As String, syazi As String
Dim uz As Byte
Dim m
Dim sayi As String
Dim bs As Byte
Dim art As Byte
Dim rakam As Byte

birler = Array("", "Bir", "İki", "Üç", "Dört", "Beş", "Altı", "Yedi", "Sekiz", "Dokuz")
onlar = Array("", "On", "Yirmi", "Otuz", "Kırk", "Elli", "Altmış", "Yetmiş", "Seksen", "Doksan")
bsayi = Array("", "Bin ", "Milyon ", "Milyar ", "Trilyon ")

sayi = Format(csayi)
uz = Len(sayi)
For m = uz To 1 Step -1
art = art + 1
rakamlar(art) = Val(Mid(sayi, m, 1))
Next
For bs = 1 To uz
art = bs Mod 3
rakam = rakamlar(bs)
yazi = ""
Select Case art
Case 1
yazi = birler(rakam) & bsayi(Int(bs / 3))
If uz = 4 And yazi = "BirBin " Then yazi = "Bin "
Case 2
yazi = onlar(rakam)
Case 0
If rakam = 0 Then
yazi = ""
ElseIf rakam = 1 Then
yazi = "Yüz"
Else
yazi = birler(rakam) & "Yüz"
End If
End Select
syazi = yazi & syazi
Next
If syazi = "" Then
syazi = "Sıfır"
Else
syazi = Replace(syazi, " Bin ", "")
syazi = Replace(syazi, " Milyar ", "")
syazi = Replace(syazi, " Milyon ", "")
End If
yçevir = syazi
End Function
-------------------------------------

 

[1Al2Ver]

Sayın xcoll,

"birde şöyle bişey buldum nette YTL için ben buradakı YTL yazan yerleri değiştirip TL yazarsan nasıl makro olarak kayıt edecegım ...."

Gönderdiğim dosya için ;Sayfa1 sekmesine sağ tıklayın, açılan pencereden "Kod Görüntüle" yi tıklayın, bir VBA penceresi açılır, solundaki kutuda VBA Project (Sayıyı Yazıya Çevir TL.xls) dosyası görünür, orada Modül1'in üzerini tıklayın, kodlar görülecektir,

Kendi sayfanıza uygulamak istediğiniz makroyu kopyalamak için yukarıda anlatıldığı gibi kodu modül'e kopyalamanız gerek,

Modül açmak için (gönderdiğim dosyada örneklersek) VBA Project (Sayıyı Yazıya Çevir TL.xls) 'nin üzerine gelip sağ tıklayınca açılan pencereden Insert buradan da modüle'ü tıklayın, sağ tarafta açılan bölüme makro kodunuzu yapıştırın.

Kolay gelsin.

 

[xcoll]

hocam tşk ederim ama ben 2007 surumunu kullanıyorum sanırım 2003 surumunden anlatıyorsun ve bende bunlar pek yok yada ben bulamadım


bırde soyle bişey var benım buraya yazdıgım koddda zaten YTL yazıyor ben Bu koddakı YTL leri TL ye cevırıp kodu kayıt etmeyı becerırsem herhangı bır sorun çıkarmı yanı yazdıgım parabırımlerını yazıya cevırken TL olarak çevvırırmı ....


Bırde soyle bişey var ben bu kodu makro olarak kayıt edebılırmıyım dosya olarak yanı .xla uzantılı nasıl kayıt edebılırım.


tşk ederım ılgınden ötürü

 

[1Al2Ver]

Eklenti ile de yapılabilir

veya, modül ve kod ile uğraşmadan,

C:\Documents and Settings\..........\Application Data\Microsoft\AddIns'e ekteki eklentiyi kopyalayın,

Dosyanızda araç çubuklarında; Araçlar-Eklentiler'i tıklayın, açılan pencereden Paraçevir.xla kutucuğunu işaretleyin,

Sayfada, Örneğin A1'e 15,55 yazın B1 yada A2'ye =paracevir(A1) yazın,

Sonuca ulaşırsınız.

 

[1Al2Ver]

hocam tşk ederim ama ben 2007 surumunu kullanıyorum sanırım 2003 surumunden anlatıyorsun ve bende bunlar pek yok yada ben bulamadım


bırde soyle bişey var benım buraya yazdıgım koddda zaten YTL yazıyor ben Bu koddakı YTL leri TL ye cevırıp kodu kayıt etmeyı becerırsem herhangı bır sorun çıkarmı yanı yazdıgım parabırımlerını yazıya cevırken TL olarak çevvırırmı ....


Bırde soyle bişey var ben bu kodu makro olarak kayıt edebılırmıyım dosya olarak yanı .xla uzantılı nasıl kayıt edebılırım.


tşk ederım ılgınden ötürü

Kodu, sayfaya kopyalayın, farklı kaydeti seçin, açılan pencereden ; kayıt türünde, en altta Microsoft Office Eklentisi (*.xla) yı seçin, makronuza bir isim verip kayıt edin, daha sonra 7 nolu mesajımdaki yolu izleyin.

 

[xcoll]

veya, modül ve kod ile uğraşmadan,

C:\Documents and Settings\..........\Application Data\Microsoft\AddIns'e ekteki eklentiyi kopyalayın,

Dosyanızda araç çubuklarında; Araçlar-Eklentiler'i tıklayın, açılan pencereden Paraçevir.xla kutucuğunu işaretleyin,

Sayfada, Örneğin A1'e 15,55 yazın B1 yada A2'ye =paracevir(A1) yazın,

Sonuca ulaşırsınız.

ellerıne saglık hocam ben bu son ektekı xla dosyasını yaptım 15,45 yazınca Onbeş Lira Kırkbeş Kuruş yazıyor
çoközür diliyorum eger çok uzun bir işlem değil ise bunu Onbeş TL Kırkbeş Kr ddiye yazabılırmısın.

 

[1Al2Ver]

Eklenti dosyasında, modüldeki kodu ;

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " Lira " & Cevir(Kurus) & " Kuruş"

Aşağıdaki gibi,

ParaCevir = IIf(Para < 0, "Eksi ", "") & Cevir(Lira) & " TL " & Cevir(Kurus) & " Kr" yapın, sanırım düzelir

 

[xcoll]

ekteki dosyanın modul kodunu nasıl acacagım kı

yanı anladıgım kadarıyla makronun (.xla ) içine gir dıyorsun onu nasıl içine girecegım

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı eklenti olarak kaydedin. Ve aşağıdaki linkteki anlatımdaki gibi uygulayın.

Dosyanın VBA şifresi = www.excel.web.tr


http://www.excel.web.tr/f60/haz-rlanan-eklenti-dosyas-n-excele-tan-tmak-t61736.html

 

[1Al2Ver]

ekteki dosyanın modul kodunu nasıl acacagım kı

yanı anladıgım kadarıyla makronun (.xla ) içine gir dıyorsun onu nasıl içine girecegım

Eklenti, istediğiniz şekle dönüştürüldü, eklentilerin çalışması için gerekenler 7 nolu mesajdadır, adımları izleyerek sonuca ulaşabilirsiniz.

 

[xcoll]

ok tşk. ederım ellerıne saglık...

 

[furens]

1021,95 rakamında hata veriyor BirBin diye başlıyor

 

[xcoll]

1021,95 rakamında hata veriyor BirBin diye başlıyor

bi yanlışlık yapıyorsun sanırım cunku bende doğru çalışıyor .
1021,95 yazınca bile

 

[alitiras]

sıfır kuruş yazılmaz

Sub YTL()

End Sub
Function YeniTL(sayi, Optional tür As Byte = 0)
'Rakamı yeni türk lirası türünden belirt
'
'Makro S Şahin tarafından kaydedildi
'Ali tıraş tarafından düzeltildi
'Stil =0 YTL ve YKR
' 1 Yalnız YTL
' 2 Tam sayı ise yalnız YTL
Dim tam
Dim küsur As Byte
Dim syazi As String

If IsNumeric(sayi) And Len(Format(sayi)) < 16 Then
sayi = Int(sayi * 100) / 100
If sayi < 0 Then
syazi = "Eksi "
sayi = Abs(sayi)
End If
tam = Int(sayi)
küsur = (sayi - tam) * 100
syazi = syazi & yçevir(tam) & " TürkLirası "
If (küsur > 0) And tür = 0 Or (tür = 2 And küsur > 0) Then
syazi = syazi & yçevir(küsur) & " Kuruş "
End If
Else
syazi = "Hata"
End If
YeniTL = syazi
End Function

Function yçevir(csayi)
Dim birler, onlar, bsayi
Dim rakamlar(1 To 15) As Byte
Dim yazi As String, syazi As String
Dim uz As Byte
Dim m
Dim sayi As String
Dim bs As Byte
Dim art As Byte
Dim rakam As Byte

birler = Array("", "Bir", "İki", "Üç", "Dört", "Beş", "Altı", "Yedi", "Sekiz", "Dokuz")
onlar = Array("", "On", "Yirmi", "Otuz", "Kırk", "Elli", "Altmış", "Yetmiş", "Seksen", "Doksan")
bsayi = Array("", "Bin ", "Milyon ", "Milyar ", "Trilyon ")

sayi = Format(csayi)
uz = Len(sayi)
For m = uz To 1 Step -1
art = art + 1
rakamlar(art) = Val(Mid(sayi, m, 1))
Next
For bs = 1 To uz
art = bs Mod 3
rakam = rakamlar(bs)
yazi = ""
Select Case art
Case 1
yazi = birler(rakam) & bsayi(Int(bs / 3))
If uz = 4 And yazi = "BirBin " Then yazi = "Bin "
Case 2
yazi = onlar(rakam)
Case 0
If rakam = 0 Then
yazi = ""
ElseIf rakam = 1 Then
yazi = "Yüz"
Else
yazi = birler(rakam) & "Yüz"
End If
End Select
syazi = yazi & syazi
Next
If syazi = "" Then
syazi = "Sıfır"
Else
syazi = Replace(syazi, " Bin ", "")
syazi = Replace(syazi, " Milyar ", "")
syazi = Replace(syazi, " Milyon ", "")
End If
yçevir = syazi
End Function

 

[morphey]

Merhaba ben burda arada boşluk olmadan yapmak istiyorum ancak

bsayi = Array("", "Bin", "Milyon", "Milyar", "Trilyon") bu şekilde düzeltince binler düzelmiyor. Bunun için neresini düzeltmem gerekli yani binlerden sonra hep boşluk oluyor eğer ki
If uz = 4 And yazi = "BirBin " Then yazi = "Bin "
bu satırdaki boşlukları alırsam binler kısmını hiç yazmıyor

Yardımlarınız için şimdiden teşekkürler.