Word'de rakamı yazıya çevirme

P

penguen6363

Katılım
21 Kasım 2008
Mesajlar
112
Excel Vers. ve Dili
EXCEL2000
Altın Üyelik Bitiş Tarihi
10.03.2023
Selam Arkadaşlar
Forumda arama yaptım ama bulamadım wordde rakkamı yazıya çevirebiliyormuyuz.
Teşekkürler.
 
uzmanamele

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,417
Excel Vers. ve Dili
excel 2010
merhaba
syn Haluk'un böyle bir çalışması sitede olacak.
word sorularında arama yapınız.
 
P

penguen6363

Katılım
21 Kasım 2008
Mesajlar
112
Excel Vers. ve Dili
EXCEL2000
Altın Üyelik Bitiş Tarihi
10.03.2023
Malesef Sayın Uzman Amele
Konuyla ilgili bir soru ve cevap var ama 2007 yılı lduğu için dosyayı açmıyor :frown:
 
uzmanamele

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,417
Excel Vers. ve Dili
excel 2010
merhaba
syn Haluk'un Word içinde sayıyı yazıya çevirme kodlarını ytl den tl ye uyarlamaya çalıştım.

boş bir word belgesi açın,
visual basic düzenleyicisinde Normal / Microsoft Word Objects / Thisdocument içersine aşağıdaki kodları yazın.
sayıyı seçip sağ tuş ile TL yaz... (Raider ®) tıklayın

Kod: 
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... (Raider ®)"
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... (Raider ®)"
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... (Raider ®)"
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 = Selection & TL(Selection)
End If
End Sub
'
Sub AutoExit()
Application.CommandBars("Text").Reset
Application.CommandBars("Fields").Reset
Application.CommandBars("Table Text").Reset
End Sub
 
Ali

Ali

Uzman
Katılım
21 Temmuz 2005
Mesajlar
7,894
Excel Vers. ve Dili
İş:Excel 2016-Türkçe
Bende dosyayı ekleyeyim.
 

Ekli dosyalar

P

penguen6363

Katılım
21 Kasım 2008
Mesajlar
112
Excel Vers. ve Dili
EXCEL2000
Altın Üyelik Bitiş Tarihi
10.03.2023
Teşekkür

Sayın Uzmanamele ve Ali

İlginiz ve katkılarınız için çok teşekkürler
 
A

ACAREXTT03

Katılım
23 Haziran 2009
Mesajlar
1
Excel Vers. ve Dili
EXCEL 2003
Ben çalıştırdım süper oldu da...
Benim başka bir düşüncem var.

Excel de olduğu gibi başka bir metin kısmına bunu otomatik yazabilirmi...

Faturalarda yazılan rakamların başka bir kolonda tl sini yazmak gibi...
 
M

makan

Katılım
23 Aralık 2006
Mesajlar
258
Excel Vers. ve Dili
Windows 10 Pro 64 bit
Office 2016 Professionel Plus 64 bit
Ben sağ tıklıyorum ama ytl yaz diye bir menü çıkmıyor.
 
C

corsan75

Katılım
19 Ocak 2010
Mesajlar
89
Excel Vers. ve Dili
excel 2007 türkçe
uzmanamele' Alıntı:
merhaba
syn Haluk'un Word içinde sayıyı yazıya çevirme kodlarını ytl den tl ye uyarlamaya çalıştım.

boş bir word belgesi açın,
visual basic düzenleyicisinde Normal / Microsoft Word Objects / Thisdocument içersine aşağıdaki kodları yazın.
sayıyı seçip sağ tuş ile TL yaz... (Raider ®) tıklayın

Kod: 
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... (Raider ®)"
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... (Raider ®)"
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... (Raider ®)"
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 = Selection & TL(Selection)
End If
End Sub
'
Sub AutoExit()
Application.CommandBars("Text").Reset
Application.CommandBars("Fields").Reset
Application.CommandBars("Table Text").Reset
End Sub
Genişletmek için tıkla ...
Sayın hocam ağolun çok işime yarayacak yalnız bir sorunum var yazıya çevirme işini bir alt satırda değilde rakamın olduğu satırda yapması için ne yapmam gerekir.yardımcı olursanız sevinirim.
 
Son düzenleme:
G

goblinelf

Katılım
25 Kasım 2011
Mesajlar
1
Excel Vers. ve Dili
xlsx
word de bu makroyu çalıştıracak bir buton oluşturmak istiyorum. buton oluşturuyorum ama o makroyu nasıl atayacağımı bilmiyorum. yardımlarınız için şimdiden teşekkürler
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst