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: 497
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,370
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: 497
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,029
Excel Vers. ve Dili:
İş : Ofis 2016 - Türkçe Ev: Yok maalesef.
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 Çevrimiçi   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: 497
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 10:09


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

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden