Cümlenin ilk harfini büyük harf yapmak

[ASLAN7410]

Sayın Haluk Bey, ilginiz için çok teşekkür ediyorum. Göndermiş olduğunuz kodu denedim, H sütununda bilgi girip enter yaptığımda aşağıdaki göndermiş olduğum resimdeki hatayı veriyor. Debug'a basınca excel kilileniyor sonra kapanıp açılıyor.

 

[Haluk]

19 No'lu mesajdaki kodu tekrar düzenledim. İsterseniz, ekli dosyadan da bakabilirsiniz....

.

 

[ASLAN7410]

Sayın Haluk Bey, 22 nolu mesajdaki dosyada ve 19 nolu mesajdaki kodu denedim, hücre içerisine bilgi yazıp enter'e bastığımda Debug hatası veriyor, Debug'a bastığımda excel kilitleniyor sonra kapanıp tekrar açılıyor.

 

[Haluk]

Üzgünüm ama bende bir problem yok..... Ekran görüntüsü aşağıdadır.

 

[ASLAN7410]

Sayın Haluk Bey 22 nolu mesajdaki dosyanızı indirdim orada da denedim ekte gönderdiğim hata mesajı alıyorum.
Valla sorun neden kaynaklanıyor bilmiyorum, 32 bit ofis 2103 Türkçe kullanıyorum.

 

[ASLAN7410]

Sayın Haluk Bey, hata mesajını engellemek için aşağıdaki kod satırını kod'un en üst bölümüne eklesem bi sorun olur mu? Ya da nereye eklemeliyim? Bu çözüm olur mu?

On Error Resume Next

 

[Haluk]

Aslan Bey, kod sizde neden çalışmadı bilmiyorum ...... Ama bir ihtimal, kodları Worksheet_Change kısmından silip, Worksheet_SelectionChange kısmına yapıştırıp, öyle deneyin....

.

 

[Ömer BARAN]

Tekrar merhaba.
İstanbul'a vasıl oldum, kod'a baktığımda sanıyorum aşağıdaki şekilde sorunsuz çalışıyor.
Sayfanın kod bölümüne uygulayınız.

Dim Kontrol As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
If Kontrol = True Then Exit Sub
If Not Intersect(Target, Range("H7:H100")) Is Nothing Then
    cumle = WorksheetFunction.Trim(Target.Text)
    For k = 3 To Len(cumle) - 1
        If Mid(cumle, k, 1) = "." Or Mid(cumle, k, 1) = "!" Or Mid(cumle, k, 1) = "?" Then
            cumle = Left(cumle, k) & " " & UCase(Mid(cumle, k + 2, 1)) & Mid(cumle, k + 3, Len(cumle))
        End If
    Next
    Kontrol = True
    Target = UCase(Left(cumle, 1)) & Mid(cumle, 2, Len(cumle))
End If
    Kontrol = False
End Sub

 

[ASLAN7410]

Sayın Haluk Bey, On Error Resume Next bu kodu yazmış olduğunuz kod'un üst kısmına eklediğimde istediğim sonuçları aldım.

İlginiz ve emeğinize çok teşekkür ediyorum, hayırlı geceler diliyorum.

 

[ASLAN7410]

Sayın Ömer Bey, size de çok teşekkür ediyorum, her iki kod'da süper oldu.
Yardımcı olan herkesin ellerine sağlık, hayırlı geceler diliyorum.

 

[ASLAN7410]

Sayın Ömer Bey, sizden küçük bir çözüm isteyebilir miyim?
Bu işlemi sadece H7 hücresi için formülle çözüm olup, I7 hücresine yazsın istiyorum, yardımcı olur musunuz?

 

[Haluk]

Sayın Ömer Bey, sizden küçük bir çözüm isteyebilir miyim?

Ömer Bey nasıl düşünür bilemiyorum ama, bana göre; istediğiniz şey aslında çok da küçük bir şey değil ....

Ekli dosyadaki formülün işinizi göreceğini zannediyorum.

.

 

[Ömer BARAN]

Sayın Haluk Bey formüller çözümü vermiş.
Fark ettiğim, kontrol edilmeyen tek unsur var o da bir'den fazla boşluk karakterinin yanyana olması durumu.
Haluk Bey'in verdiği formülde H7 yerine KIRP(H7) yazılarak o da halledilebilir.

Haluk Bey'in de belirttiği gibi, işlem küçük bir işlem değil.
Neticede hücredeki metin karakter bazında tek tek kontrol edilmek durumunda.
Aslında Ms.Word'deki "TÜMCE DÜZENİ" işlemi tam olarak istediğiniz şey sanırım.
Nette baktığımda word makrosu olarak ...Range.Case = wdTitleSentence şeklinde bir kod gördüm.
Bu kod Ms.Excel'de kullanılabilir mi bilemiyorum.
.

 

[Haluk]

Ömer Bey;

Bahsettiğiniz KIRP/TRIM konusu benim de aklıma gelmişti ama saat 01:00'e geliyordu ve bilgisayarı kapatmıştım....

Diğer yandan; söz konusu iş için aşağıdaki alternatif de kullanılabilir. Yaptığım denemelerde bir sıkıntı olmadı ...

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Start As Boolean
    If Not Intersect(Target, Range("H7:H100")) Is Nothing Then
        myStr = Application.WorksheetFunction.Trim(Target.Value)
        Start = True
        For i = 1 To Len(myStr)
            strCharacter = Mid(myStr, i, 1)
            Select Case strCharacter
                Case ".", "?", "!"
                    Start = True
                Case "a" To "z"
                    If Start Then strCharacter = UCase(strCharacter)
                    Start = False
                Case "A" To "Z"
                    If Start Then
                        Start = False
                    Else
                        strCharacter = LCase(strCharacter)
                    End If
            End Select
            Mid(myStr, i, 1) = strCharacter
        Next
        Target.Value = myStr
    End If
End Sub

 

[Haluk]

.....
...
Aslında Ms.Word'deki "TÜMCE DÜZENİ" işlemi tam olarak istediğiniz şey sanırım.
Nette baktığımda word makrosu olarak ...Range.Case = wdTitleSentence şeklinde bir kod gördüm.
Bu kod Ms.Excel'de kullanılabilir mi bilemiyorum.
.

Ömer Bey;

Yukarıdaki mesajınız üzerine aşağıdaki kodu hazırladım. Excel çalışma sayfasında H7 hücresindeki metni, arka planda oluşturulan bir Word dokümanında bahsettiğiniz şekilde işlemden geçirip tekrar H7 hücresine yerleştiriyor.

Sub Test()
    'Haluk - 14/08/2018
    Dim objWord As Object, newDoc As Object
    
    Set objWord = CreateObject("Word.Application")
    Set newDoc = objWord.Documents.Add
    
    newDoc.Range.Text = Range("H7").Text
    newDoc.Range.Case = 4
    Range("H7") = newDoc.Range.Text
    
    newDoc.Close SaveChanges:=False
    objWord.Quit
    Set newDoc = Nothing
    Set objWord = Nothing
End Sub

 

[ASLAN7410]

Sayın Haluk Bey, 32.mesajınızdaki örnek dosyadaki formül süper çalışıyor, ayrıca 34. mesajınızda önceki kodları yeniden düzenlemiş siniz, bu daha da güzel çalışıyor, ellerinize sağlık, çok teşekkür ediyorum. Hayırlı çalışmalar diliyorum.

Sayın Ömer Bey, size de çok teşekkür ediyorum. Hayırlı çalışmalar diliyorum.

 

[hakankilic]

Çok detaylı inceleyemedim ama, RegExp metodu ile yapılan aşağıdaki alternatifi deneyebilirsiniz ....

Bu kodla; cümlelerin nokta, soru işareti ve ünlem işareti ile bitmesi halinde, takip eden cümlenin ilk kelimesinin birinci harfi büyük harfe çevrilir.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RegExp As Object, myData As Object
    If Not Intersect(Target, Range("H7:H100")) Is Nothing Then
        myStr = WorksheetFunction.Trim(LCase(Target.Text))
        Set RegExp = CreateObject("VBScript.RegExp")
        RegExp.Pattern = "[.?!]\s."
        RegExp.Global = True
        For Each myData In RegExp.Execute(myStr)
            myStr = Application.Replace(myStr, myData.firstIndex + 1, myData.Length, UCase(myData.Value))
        Next
        If myStr = "" Then Exit Sub
        Target = Application.Replace(myStr, 1, 1, UCase(Left(myStr, 1)))
        Set RegExp = Nothing
    End If
End Sub

Hocam karakter Türkçe değil. Büyük harften küçük harfe dönüştürürken TR İ ler İ olarak kalıyor.