• DİKKAT

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

Büyük harf yapma

  • Konbuyu başlatan Konbuyu başlatan ormann
  • Başlangıç tarihi Başlangıç tarihi
Katılım
9 Ekim 2009
Mesajlar
1,626
Excel Vers. ve Dili
türkçe
2003
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.
 

Ekli dosyalar

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
 
İlgili sayfanın kod kısmına ekleyin.
Kod:
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
 
sayın hocam bunu 7.mesajıma uygulayabilirmisiniz
 
Son düzenleme:
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
 

Ekli dosyalar

Kod:
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.
 
sayın hocam vermiş olduğunuz kodu denedim oldu fakat diğre veri çağırmada programda hata veriyo
 
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)
 
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.

Kod:
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
 
hocam ellerinize sağlık çok teşekkür ederim
 
Geri
Üst