Büyük harf yapma

[ormann]

Arkafdaşlar ekteki örnek dosyamda b5 hücresine küçük harflerle herhangi bir kelime yada isim yazdığımda bunun kendiliğinden büyük harfe çevirilmesini ve aynızaman da türkçe karakterlerin aynı olarak büyük harfe çevirilmesini isityorum bu mümkünmüdür yardımcı olurmusunuz.

 

[hamitcan]

Arama yaparsanız, daha çok uygulama bulabilirsiniz.
http://www.excel.web.tr/showthread.php?t=74825&highlight=b%FCy%FCk-k%FC%E7%FCk+harf

 

[ormann]

sayın hocam linkleri inceledim fakat belirtmiş olduğum hücrede otamatik olarak uygulanmasını istiyorum .formda ise sağ tıklayıp manuel olarak yapılmasını tarif ediyo.bunu bir makro ile otamatik olarak yapma imkanı yokmu acaba

 

[hamitcan]

İlgili sayfanın kod kısmına ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$5" Then Exit Sub
Application.EnableEvents = False
    Target = StrConv(Target, vbUpperCase)
    Target.Replace What:="I", Replacement:="İ", MatchCase:=True
    Target.Replace What:="ı", Replacement:="I", MatchCase:=True
Application.EnableEvents = True
End Sub

 

[ormann]

hocam ellerinize sağlık

 

[ormann]

sayın hocam bunu 7.mesajıma uygulayabilirmisiniz

 

[ormann]

sayın hocam yapmış olduğunuz uygulamayı ben kendi programıma uygulamaya çalıştım fakat bir türlü beceremedm.sizden ricam göndermiş olduğum ek dosyamdaki veri girişi bölümünde bulunan d8-d12-d13-d14-d21 hücrelerine de bu uygulamayı ekleyeblirmisiniz

 

[hamitcan]

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [d8,d12,d13, d14, d21]) Is Nothing Then
Application.EnableEvents = False
    Target = StrConv(Target, vbUpperCase)
    Target.Replace What:="I", Replacement:="İ", MatchCase:=True
    Target.Replace What:="ı", Replacement:="I", MatchCase:=True
Application.EnableEvents = True
End If

If Intersect(Target, [C3:E3]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Dim C As Range, s1 As Worksheet, say As Long
Set s1 = Sheets("SUÇ KAYDI")
say = Application.WorksheetFunction.Match(Target.Offset(-1, 0), s1.[3:3], 0)
Set C = s1.Columns(say).Find(Target.Value, LookIn:=xlValues)
If Not C Is Nothing Then
Sheets("VERİ GİRİŞİ").Unprotect 1978
Range("D5").ClearContents
s1.Range("B" & C.Row & ":AV" & C.Row).Copy
Range("D5:d51").PasteSpecial xlPasteValues, xlNone, False, True
Application.CutCopyMode = False
Range("C3").Select
Sheets("VERİ GİRİŞİ").Protect 1978
Else
    MsgBox Target.Value & " BİLGİSİNİ BULAMADIM", vbInformation, "Alidogan5557@hotmail.com"
End If
End Sub

şeklinde deneyin.

 

[ormann]

sayın hocam vermiş olduğunuz kodu denedim oldu fakat diğre veri çağırmada programda hata veriyo

 

[ormann]

sayın hocam vermiş olduğunuz kodu denedim oldu fakat c3-de-e3 hücrelerinden veri çağırdığımda programda hata veriyo Target = StrConv(Target, vbUpperCase)

 

[hamitcan]

Programanıza bir eleştiri yapacağım. Bu şekilde kapsamlı kod yazdığınızda sayfa olaylarını daha az kullanmayı tercih edin. Çünkü, kod içinde bir yere dokunduğunuzda işin içinden çıkamayabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Sheets("VERİ GİRİŞİ").Unprotect 1978
If Not Intersect(Target, [d8,d12,d13, d14, d21]) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
    Target = StrConv(Target, vbUpperCase)
    Target.Replace What:="I", Replacement:="İ", MatchCase:=True
    Target.Replace What:="ı", Replacement:="I", MatchCase:=True
Application.EnableEvents = True
End If

If Intersect(Target, [C3:E3]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Dim C As Range, s1 As Worksheet, say As Long
Set s1 = Sheets("SUÇ KAYDI")
say = Application.WorksheetFunction.Match(Target.Offset(-1, 0), s1.[3:3], 0)
Set C = s1.Columns(say).Find(Target.Value, LookIn:=xlValues)
If Not C Is Nothing Then

Range("D5").ClearContents
s1.Range("B" & C.Row & ":AV" & C.Row).Copy
Range("D5:d51").PasteSpecial xlPasteValues, xlNone, False, True
Application.CutCopyMode = False
Range("C3").Select
Sheets("VERİ GİRİŞİ").Protect 1978
Else
    MsgBox Target.Value & " BİLGİSİNİ BULAMADIM", vbInformation, "Alidogan5557@hotmail.com"
End If
End Sub

 

[ormann]

hocam ellerinize sağlık çok teşekkür ederim