Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > Diğer Yazılımlar > Windows-Word-PowerPoint....
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Windows-Word-PowerPoint.... Excel haricindeki Ofis programları ile ilgili konular.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 17-05-2017, 10:48   #1
levo26
 
levo26 kullanıcısının avatarı
 
Giriş: 22/04/2010
Şehir: Eskişehir
Mesaj: 519
Excel Vers. ve Dili:
Excel 2007 TR
Varsayılan wordde yazı ile yazdırmak.

Merhaba;
Aşağıdaki kodlar ile daha önce (2003 versiyonu) rakam yazıp örneğin 36,69 yazdığımda ve seçim yaparak sağ klik ile makroyu çalıştırdığımda OTUZALTI TÜRKLİRASI VE ALTMIŞDOKUZ KURUŞ şeklinde yazıyordu. 2007 versiyonu için yapmak itiyorum ayni makroyu çalıştırdığımda kuruşları tanımıyor. 36,69 yazıyı ÜÇBİNALTIYÜZALTMIŞDOKUZ TÜRK LİRASI şeklinde yazıyor.

Dim MyBar As CommandBar
Dim MyBar2 As CommandBar
Dim MyBar3 As CommandBar
'
Sub AutoExec()
Call PopUpMenu
End Sub
'
Sub PopUpMenu()
Set MyBar = Application.CommandBars("Text")
Set MyBar2 = Application.CommandBars("Fields")
Set MyBar3 = Application.CommandBars("Table Text")
'
On Error Resume Next
MyBar.FindControl(Tag:="TagTL").Delete
MyBar2.FindControl(Tag:="TagTL").Delete
MyBar3.FindControl(Tag:="TagTL").Delete
On Error GoTo 0
'
Set MenuObject = MyBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
MenuObject.Tag = "TagTL"
MenuObject.Caption = "TL yaz... yazalim)"
MenuObject.BeginGroup = True
MenuObject.OnAction = "YazTL"
MenuObject.FaceId = 7
'
Set MenuObject = MyBar2.Controls.Add(Type:=msoControlButton, Temporary:=True)
MenuObject.Tag = "TagTL"
MenuObject.Caption = "TL yaz... yazalim)"
MenuObject.BeginGroup = True
MenuObject.OnAction = "YazTL"
MenuObject.FaceId = 7
'
Set MenuObject = MyBar3.Controls.Add(Type:=msoControlButton, Temporary:=True)
MenuObject.Tag = "TagTL"
MenuObject.Caption = "TL yaz... yazalim)"
MenuObject.BeginGroup = True
MenuObject.OnAction = "YazTL"
MenuObject.FaceId = 7
'
Set MyBar = Nothing
Set MyBar2 = Nothing
Set MyBar3 = Nothing
Set MenuObject = Nothing
End Sub
'
Function TL(sayi)
sayi = Round(sayi, 2)
x = InStr(1, sayi, ",")
If x > 0 Then
Lira = yaz$(Mid(sayi, 1, x - 1)) & " TÜRK LİRASI "
TempKurus = Mid(sayi, x + 1, 98)
If Len(TempKurus) = 1 Then TempKurus = TempKurus * 10
Kurus = yaz$(TempKurus) & " KURUŞ "
Else
Lira = yaz$(sayi) & " TÜRK LİRASI "
End If
TL = 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) = "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) = "TRILYON"
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
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$ = "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$ = "" + s$
yaz$ = s$
GoTo tamam
hata: yaz$ = "hata"
tamam:
End Function
'
Sub YazTL()
If IsNumeric(Selection) Then
Selection = TL(Selection)
End If
End Sub
'
Sub AutoExit()
Application.CommandBars("Text").Reset
Application.CommandBars("Fields").Reset
Application.CommandBars("Table Text").Reset
End Sub
levo26 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 17-05-2017, 11:40   #2
asri
Altın Üye
 
Giriş: 24/04/2005
Şehir: Istanbul
Mesaj: 2,553
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Varsayılan

Word 2010 TR de denedim. Sorun görünmüyor.

OTUZALTI TÜRK LİRASI ALTMIŞDOKUZ KURUŞ
__________________
www.asriakdeniz.com
asri Çevrimdışı   Alıntı Yaparak Cevapla
Eski 17-05-2017, 12:21   #3
levo26
 
levo26 kullanıcısının avatarı
 
Giriş: 22/04/2010
Şehir: Eskişehir
Mesaj: 519
Excel Vers. ve Dili:
Excel 2007 TR
Varsayılan

Sayın Asri:
Teşekkür ederim. Sorun bölgesel ayarlardaymış. Nokta virgül değişimini yaptım çözüldü. Sağolun.
levo26 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 17-05-2017, 12:30   #4
YUSUF44
Destek Ekibi
 
YUSUF44 kullanıcısının avatarı
 
Giriş: 04/01/2006
Şehir: Manisa, Kula
Mesaj: 6,691
Excel Vers. ve Dili:
İş : Ofis 2016 - Türkçe Ev: Ofis 2016 - Türkçe
Varsayılan

Bunun nasıl çalıştırılacağını anlatır mısınız? Word dosyasına modul ekleyip, kodları yapıştırdır. Dosyayı makro etkinleştirilmiş word dosyası olarak kaydettim. Sayıları seçip sağ tuşa bastığımda farklı herhangi bir menü görünmüyor ya da işlem yapmıyor.
__________________


Sorularınızı örnek dosyayla desteklemeniz çözüme ulaşmanızı kolaylaştırır.

Altın Üye olmanızı öneririm. Altın Üye değilseniz dosyanızı dosya yükleme sitelerinden birine yükleyip linkini paylaşabilirsiniz.
YUSUF44 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 17-05-2017, 12:41   #5
levo26
 
levo26 kullanıcısının avatarı
 
Giriş: 22/04/2010
Şehir: Eskişehir
Mesaj: 519
Excel Vers. ve Dili:
Excel 2007 TR
Varsayılan

Merhaba,

Normal dot sayfasına yapıştır ve autoexec makrosunu çalıştır wordü kapat yeniden açtığında sağ klik yaptığında görülecekir.
levo26 Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 23:58


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Dil Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Çorlu Su Arıtma- Gebze Emlak- Rampa- Rotary- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Çorlu Sürücü Kursu- Şişli Avukat- Edirne Serbest Muhasebeci- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kağıt Bardak- Kaplan Tekstil- Çorlu Perde- Çorlu Perde- Çorlu Havuz- Çorlu Havuz- Makina- Danışmazlar- Çorlu Perde Yıkama- Çorlu Perde Yıkama- Okul Danışmanlık- Çorlu Ayakkabı- İzmit Sigorta-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden