Çalışma kitabına eklenen kodların hatası

[hakki83]

Selamlar arkadaşlar

Ekteki dosyada çalışma kitabı kısmına eklenmesi gereken şu kodlar vardır.
Otomatik büyük harf kodları

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
End Sub

Fakat eklendiğinde hata veriyor. Bu sorunu çözebilir miyiz
Renkli kısımlar kilitli hücrelerdir

 

[reosman]

Deneyiniz.

 

[hakki83]

Çok teşekkür ederim. Fakat Sayfa1 kod başlığı Worksheet SelectionChange değil de, Worksheet Change olması gerekiyor, çünkü hücreye veri girer girmez açıklama ekleniyor.

Worksheet SelectionChange olursa, hücreye veri girdikten sonra tekrar manuel olarak üstünden geçmek gerekiyor.

 

[Korhan Ayhan]

Sayfa kodunuzu aşağıdaki gibi değiştiriniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [B2:N1000]) Is Nothing Then
        ActiveSheet.Unprotect
        If Target.Cells.Count = 1 Then
            If Target.Value = "" Then
                Target.ClearComments
            Else
                Target.ClearComments
                Target.AddComment.Text vbLf & "Tarih" & vbLf & Now & vbLf
                Target.Comment.Shape.TextFrame.AutoSize = True
            End If
        ElseIf Target.Cells.Count > 1 Then
            Target.ClearComments
        End If
        ActiveSheet.Protect
    End If
End Sub

Çalışma kitabı kodunu aşağıdaki gibi değiştiriniz.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False
    Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
    Application.EnableEvents = True
End Sub

 

[hakki83]

Sayfa kodunuzu aşağıdaki gibi değiştiriniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [B2:N1000]) Is Nothing Then
        ActiveSheet.Unprotect
        If Target.Cells.Count = 1 Then
            If Target.Value = "" Then
                Target.ClearComments
            Else
                Target.ClearComments
                Target.AddComment.Text vbLf & "Tarih" & vbLf & Now & vbLf
                Target.Comment.Shape.TextFrame.AutoSize = True
            End If
        ElseIf Target.Cells.Count > 1 Then
            Target.ClearComments
        End If
        ActiveSheet.Protect
    End If
End Sub

Çalışma kitabı kodunu aşağıdaki gibi değiştiriniz.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    Application.EnableEvents = False
    Target.Value = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
    Application.EnableEvents = True
End Sub

Çok teşekkür ederim. Düzeldi.