Rakamı yazıya çevirme

Merhaba

Yazılan Rakamı Yazı ile yazma imkanı var mı derken ?

Örn. "1" yazdım otomatik olarak "bir" halini mi alması?

Kapsamlı olarak ne istediğini belirtirseniz eminim sorununuzu çözebiliriz?

İyi günler

Uğur hocam word ekranında yazdımız bir erken ödeme talimatının rakam olan para kısmını yazıya çevirmek istiyoruz.

http://www.excel.web.tr/f51/wordde-rakamlar-yaz-ile-yazd-r-labilir-mi-t3192/sayfa2 .

Tıpkı MS Excel'in *.xlt dosyaları gibi MS Word'un de *.dot dosyaları vardır.

*.xlt >> MS Excel Template
*.dot >> MS Word Document Template

Excel'de ayrıca *.xla dosyaları yaratıp, bunları eklenti olarak Excel'e tanıttığımızda bütün Excel dosyalarında ilgili makrolar çalışır.

Ancak, MS Word bu geçerli değildir (en azından ben öyle biliyorum).

Aslında, MS Word uygulamasını başlattığınız anda bilgisayarınızdaki Normal.dot dosyası açılır ve ekrana *.doc gelir. Siz de bir isim vererek dosyayı kaydedirsiniz. Bu nedenle, söz konusu Normal.dot dosyasında yapılacak her türlü değişiklik, otomatik olarak MS Word programı çalıştırıldığında veya o şablon (Normal.dot ile üretilmiş bir *.doc dosyası açıldığında, devreye girecektir.

İşin hafiften teorik kısmı böyle.....

Þimdi, eğer yukarıdaki çalışmamda bahsedilen YTL yaz ... menüsünün, yeni oluşturulan bir MS Word dosyasında veya herhangibir *.doc dosyasında geçerli olabilmesi için, aşağıdakileri resimlerde de belirtildiği gibi uygulamak yeterli olucaktır.

İlk önce açık olan bütün MS Word uygulamalarını kapatalım.

Daha sonra MS Word programını çalıştıralım.

Boş ve yeni bir *.doc sayfası ekrana geldiğinde klavyede Alt + F11 tuşlarına basarak, VBE kısmına geçelim.

Burada, sol taraftaki Project penceresinde Normal yazan yeri fare ile tıklayarak, aktif hale getirelim.

Daha sonra, yukarıda menülerden buraya yeni bir Modul ekleyelim.
Eklenen modulün, belirttiğim gibi Normal içinde olması gerekir, aksi takdirde sadece o dosyada sözkonusu makrolar çalışır.

Þimdi, bu eklediğimiz modulün (resimdeki adıyla, Module1) üzerine çift tıklayarak, ekranın sağ tarafındaki bu module ait kod penceresini açalım.

Bu modül içine aşağıdakileri Copy - Paste (Kopyala - Yapıştır) yöntemiyle yapıştıralım.

Daha sonra, yine sol taraftaki Project penceresinde Normal aktif hale getirip, yukarıdaki üzerinde "disket" işareti olan düğmeyi tıklayarak, Normal modulünü kaydedelim.

Þimdi, dosyayı kapatalım.

Herhangibir MS Word belgesini açalım veya yeni bir MS Word uygulamasını başlatıp, sayfanın üzerinde farenin sağ tuşuna basarak, yeni menünün görünüp görünmediğine bakabilirsiniz.

Bu arada; eğer MS Word programınıza ait makro güvenlik ayarlarını da gözden geçirip, bunun "Medium" (orta) seviyeye ayarlanmış olmasına da dikkat edin.

Yukarıda bahsetmiş olduğum işler için, Normal içinde oluşturulacak yeni module yerleştirilecek kodlar aşağıdadır;

[vb:1:f8752a80cd]'********************************************** ******************
'* MS Word dokumanlarinda sayi ile yazilmis bir degerin *
'* metin biciminde YTL olarak yazilmasi ile ilgili bir calismadir. *
'* *
'* Burasi Excel vadisi... *
'* Raider ® *
'* Mart 2005 *
'* *
'********************************************** ******************
'
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:="TagYTL").Delete
MyBar2.FindControl(Tag:="TagYTL").Delete
MyBar3.FindControl(Tag:="TagYTL").Delete
On Error GoTo 0
'
Set MenuObject = MyBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
MenuObject.Tag = "TagYTL"
MenuObject.Caption = "YTL yaz... (Raider ®)"
MenuObject.BeginGroup = True
MenuObject.OnAction = "YazYTL"
MenuObject.FaceId = 7
'
Set MenuObject = MyBar2.Controls.Add(Type:=msoControlButton, Temporary:=True)
MenuObject.Tag = "TagYTL"
MenuObject.Caption = "YTL yaz... (Raider ®)"
MenuObject.BeginGroup = True
MenuObject.OnAction = "YazYTL"
MenuObject.FaceId = 7
'
Set MenuObject = MyBar3.Controls.Add(Type:=msoControlButton, Temporary:=True)
MenuObject.Tag = "TagYTL"
MenuObject.Caption = "YTL yaz... (Raider ®)"
MenuObject.BeginGroup = True
MenuObject.OnAction = "YazYTL"
MenuObject.FaceId = 7
'
Set MyBar = Nothing
Set MyBar2 = Nothing
Set MyBar3 = Nothing
Set MenuObject = Nothing
End Sub
'
Function YTL(sayi)
sayi = Round(sayi, 2)
X = InStr(1, sayi, ",")
If X > 0 Then
Lira = yaz$(Mid(sayi, 1, X - 1)) & " YENİ TÜRK LİRASI "
TempKurus = Mid(sayi, X + 1, 98)
If Len(TempKurus) = 1 Then TempKurus = TempKurus * 10
Kurus = yaz$(TempKurus) & " YENİ KURUÞ "
Else
Lira = yaz$(sayi) & " YENİ TÜRK LİRASI "
End If
YTL = 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 YazYTL()
If IsNumeric(Selection) Then
Selection = YTL(Selection)
End If
End Sub
'
Sub AutoExit()
Application.CommandBars("Text").Reset
Application.CommandBars("Fields").Reset
Application.CommandBars("Table Text").Reset
End Sub
[/vb:1:f8752a80cd]