Comment Açıklama Bilgisi Kodunu Revize Etmek

Saat 23:00 gibi olabilir.Yada sonuç nasıl çıkacak onu gösterirseniz daha iyi olur.

Zafer Hocam açıklama için bakma imkanınız var mı  acaba

B sütununda uzunluk 6 olarak görülüyor oysa başında boşluk var bazılarında.Bundan dolayı 7 olarak gördüğü için çalışmıyordu bu dosyanızda.Trim ekledim fayda etmedi.Alttaki gibi çözdüm.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Açýklama_Ekleme As Comment

Dim strText



If Target.Column > 37 Then Exit Sub



If Cells(Target.Row, 2).Value <> "" And Len(Cells(Target.Row, 2).Value + 0) <> 6 Then Exit Sub

If Cells(Target.Row, Target.Column).Comment Is Nothing Then

    strText = Application.InputBox("Eklenecek olan mesajý aþaðýya yazýnýz.", _

              "Açýklama_Ekleme", "Açýklama Ekler", , , , 2)

Else

    strText = Application.InputBox("Eklenecek olan mesajý aþaðýya yazýnýz.", _

              "Açýklama_Ekleme", Target.Comment.text, , , , 2)

End If



If strText = "" Then Exit Sub

'On Error Resume Next

If strText = False Then Exit Sub

On Error GoTo 0

If Application.ExecuteExcel4Macro("Get.Cell(46)") = True Then

    Target.Comment.Delete

End If

Target.AddComment

Set Açýklama_Ekleme = Target.Comment

With Açýklama_Ekleme

    .text text:=strText

    With .Shape.TextFrame.Characters.Font

        .Name = "Arial"

        .Size = 8

        .Bold = False

    End With

End With



End Sub

Hocam özel mesaj atamıyorum

Hocam mevcut bilgi geliyor ama bu sefer de silince silinmiyor tekrar tıklayınca önceki veri geliyor
Silmek yerine 1 boşluk bırakınca comment 1 boşluk oluyor . Ama silince artık açıklama olmaması lazım boşluk koymadan açıklamanın silinmesi ve kırmızı tikin kaybolması lazım

---

Bir de b sütunda 6 rakam denetlemesi yapmıyor malesef
Misal a b c d e sütunları boş ama tıklayınca e den aj ye kadar açıklama için inputbox açılıyor
Oysa b sütununda tam 6 rakam yoksa inputbox açılmasın

(19/11/2020, 23:26)hayalibey yazdı: Bir de b sütunda 6 rakam denetlemesi yapmıyor malesef

Alttaki kodun görevi zaten o.

If Cells(Target.Row, 2).Value <> "" And Len(Cells(Target.Row, 2).Value + 0) <> 6 Then Exit Sub

---

If strText = False Then Exit Sub bu kodu değiştirdim.Boşsa çık komutu yazmıştım.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Açýklama_Ekleme As Comment

Dim strText



If Target.Column > 37 Then Exit Sub



If Cells(Target.Row, 2).Value <> "" And Len(Cells(Target.Row, 2).Value + 0) <> 6 Then Exit Sub

If Cells(Target.Row, Target.Column).Comment Is Nothing Then

    strText = Application.InputBox("Eklenecek olan mesajý aþaðýya yazýnýz.", _

              "Açýklama_Ekleme", "Açýklama Ekler", , , , 2)

Else

    strText = Application.InputBox("Eklenecek olan mesajý aþaðýya yazýnýz.", _

              "Açýklama_Ekleme", Target.Comment.text, , , , 2)

End If



If strText = "" Then

    Target.Comment.Delete

    Exit Sub

End If

'On Error Resume Next

If strText = False Then Exit Sub

On Error GoTo 0

If Application.ExecuteExcel4Macro("Get.Cell(46)") = True Then

    Target.Comment.Delete

End If

Target.AddComment

Set Açýklama_Ekleme = Target.Comment

With Açýklama_Ekleme

    .text text:=strText

    With .Shape.TextFrame.Characters.Font

        .Name = "Arial"

        .Size = 8

        .Bold = False

    End With

End With



End Sub