• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

proper fonsiyonunun access deki karşılığı

R

rcekinir

Katılım
7 Temmuz 2004
Mesajlar
82
Excel Vers. ve Dili
Office 2016 Türkçe
Arkadaşlar
access de metin kutusuna örneğin "ramazan çekinir"
yazdığımda metin kusundan çıkarken bunun "Ramazan Çekinir"
olmasını istiyorum.
Bunu excelde WorksheetFunction.Proper fonksiyonu ile yapabiliyorduk.
access de bunun karşılığı olan fonksiyonu bulamadım.Ya da başka bir yolla yapamadım.Yardımlarınızı rica ediyorum.
 
Sn Jale
Fonksiyon aradığım fonksiyon fakat türkçede i,İ,ı,I harflerle ilgili ekleme yapmam gerekiyor.
İlginize Teşekkür ederim.
 
Günaydın :hey:

Evet şimdi bende denedim çok garip neden diğer türkçe harfleri destekliyorda bu ikisini desteklemiyor? ö,ç,ğ,ş de hiç bir sorun yok.
 
Merhaba,
Amatörce ama benden katkı :) Üç isimli söcükler için çalışır durumda...


Function YAZIMDUZENI(metin As String)
Dim t, ilk1, ilk2, ilk3, kalan1, kalan2, kalan3, dkalan1, dkalan2, dkalan3 As String
Dim b1, b2 As Integer
t = Trim(metin)
'//////////////////////////
b1 = InStr(1, t, " ") 'İlk boşluğun sıra numarası
b2 = InStr(b1 + 1, t, " ") 'İkinci boşluğun sıra numarası
'//////////////////////////
ilk1 = Left(t, 1) 'İlk sözcüğün ilk harfi
ilk2 = Mid(t, b1 + 1, 1) 'İkinci sözcüğün ilk harfi
ilk3 = Mid(t, b2 + 1, 1) 'Üçüncü söcüğün ilk harfi
'//////////////////////////
If b1 = 0 Then 'Tek sözcükken
kalan1 = Mid(t, 2, Len(t) - 1)
ElseIf b1 >= b2 Then 'İki sözcükken
kalan1 = Mid(t, 2, b1 - 2)
kalan2 = Mid(t, b1 + 2, Len(t) - b1 - 1)
ElseIf b2 > b1 Then 'Üç sözcükken
kalan1 = Mid(t, 2, b1 - 2)
kalan2 = Mid(t, b1 + 2, b2 - b1 - 2)
kalan3 = Mid(t, b2 + 2, Len(t) - b2 - 1)
End If
'/////////////////////////
dkalan1 = StrConv(Replace(Replace(kalan1, Chr(73), Chr(253)), Chr(221), Chr(105)), 2)
dkalan2 = StrConv(Replace(Replace(kalan2, Chr(73), Chr(253)), Chr(221), Chr(105)), 2)
dkalan3 = StrConv(Replace(Replace(kalan3, Chr(73), Chr(253)), Chr(221), Chr(105)), 2)
'/////////////////////////
If b1 = 0 Then ''Tek sözcükken
YAZIMDUZENI = Trim(ilk1 & dkalan1)
ElseIf b1 >= b2 Then ''İki sözcükken
YAZIMDUZENI = Trim(ilk1 & dkalan1 & " " & ilk2 & dkalan2)
ElseIf b2 > b1 Then 'Üç sözcükken
YAZIMDUZENI = Trim(ilk1 & dkalan1 & " " & ilk2 & dkalan2 & " " & ilk3 & dkalan3)
Else
YAZIMDUZENI = "!!!ÇOK UZUN AD!!!"
End If
End Function
 
MS Access için Yazım.Düzeni (Proper) Fonksiyonu

Function YAZIMDUZENI(metin As String)
'///////////////////////////////////
'+ + +//////////////////////+ + +
'///////////////////////////////////
'Chr(105)=i, Chr(221)=İ, Chr(73)=I, Chr(253)=I, Chr(32)= " "
Dim m, a, b, c, d As String
m = " " & Trim(metin) 'Metnin başına göstermelik boşluk ekle
a = Replace(Replace(Replace(m, Chr(105), Chr(221), , , vbBinaryCompare), Chr(253), Chr(73)), Chr(46), Chr(46) & Chr(32)) 'Küçük harfle yazılmış olma ihtimaline karşı i>İ, ı>I dönüşümü yap.
'Ayrıca nokta imi nokta boşluğa dönüştürülür, unvanlarda yazım hatası olmasın diye
b = LCase(Replace(Replace(a, Chr(73), Chr(253)), Chr(221), Chr(105))) 'İ>i, I>ı dönüşümü yap, küçük harfe çevir.
c = Replace(Replace(b, Chr(32) & Chr(105), Chr(32) & Chr(221)), Chr(32) & Chr(253), Chr(32) & Chr(73)) 'Boşluk+i>Boşluk+İ, Boşluk+ı>Boşluk+I dönüşümü yap.
d = Replace(StrConv(Trim(c), vbProperCase), Chr(46) & Chr(32), Chr(46)) 'Boşlukları al yazım düzenine çevir. Nokta boşlukları yeninde noktaya çevir.
YAZIMDUZENI = d
End Function
 
mcuma' Alıntı:
Function YAZIMDUZENI(metin As String)
'///////////////////////////////////
'+ + +//////////////////////+ + +
'///////////////////////////////////
'Chr(105)=i, Chr(221)=İ, Chr(73)=I, Chr(253)=I, Chr(32)= " "
Dim m, a, b, c, d As String
m = " " & Trim(metin) 'Metnin başına göstermelik boşluk ekle
a = Replace(Replace(Replace(m, Chr(105), Chr(221), , , vbBinaryCompare), Chr(253), Chr(73)), Chr(46), Chr(46) & Chr(32)) 'Küçük harfle yazılmış olma ihtimaline karşı i>İ, ı>I dönüşümü yap.
'Ayrıca nokta imi nokta boşluğa dönüştürülür, unvanlarda yazım hatası olmasın diye
b = LCase(Replace(Replace(a, Chr(73), Chr(253)), Chr(221), Chr(105))) 'İ>i, I>ı dönüşümü yap, küçük harfe çevir.
c = Replace(Replace(b, Chr(32) & Chr(105), Chr(32) & Chr(221)), Chr(32) & Chr(253), Chr(32) & Chr(73)) 'Boşluk+i>Boşluk+İ, Boşluk+ı>Boşluk+I dönüşümü yap.
d = Replace(StrConv(Trim(c), vbProperCase), Chr(46) & Chr(32), Chr(46)) 'Boşlukları al yazım düzenine çevir. Nokta boşlukları yeninde noktaya çevir.
YAZIMDUZENI = d
End Function
Genişletmek için tıkla ...

hocam sırf sana tşk etmek için üye oldum ellerine sağlık sorunsuz çalışıyor
 
mcuma' Alıntı:
Function YAZIMDUZENI(metin As String)
'///////////////////////////////////
'+ + +//////////////////////+ + +
'///////////////////////////////////
'Chr(105)=i, Chr(221)=İ, Chr(73)=I, Chr(253)=I, Chr(32)= " "
Dim m, a, b, c, d As String
m = " " & Trim(metin) 'Metnin başına göstermelik boşluk ekle
a = Replace(Replace(Replace(m, Chr(105), Chr(221), , , vbBinaryCompare), Chr(253), Chr(73)), Chr(46), Chr(46) & Chr(32)) 'Küçük harfle yazılmış olma ihtimaline karşı i>İ, ı>I dönüşümü yap.
'Ayrıca nokta imi nokta boşluğa dönüştürülür, unvanlarda yazım hatası olmasın diye
b = LCase(Replace(Replace(a, Chr(73), Chr(253)), Chr(221), Chr(105))) 'İ>i, I>ı dönüşümü yap, küçük harfe çevir.
c = Replace(Replace(b, Chr(32) & Chr(105), Chr(32) & Chr(221)), Chr(32) & Chr(253), Chr(32) & Chr(73)) 'Boşluk+i>Boşluk+İ, Boşluk+ı>Boşluk+I dönüşümü yap.
d = Replace(StrConv(Trim(c), vbProperCase), Chr(46) & Chr(32), Chr(46)) 'Boşlukları al yazım düzenine çevir. Nokta boşlukları yeninde noktaya çevir.
YAZIMDUZENI = d
End Function
Genişletmek için tıkla ...

Çok Çok teşekkür ederim. Bir tek sizin yaptığınız örnek düzgün çalıştı. Allah razı olsun.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst