(20/11/2020, 01:10)hayalibey yazdı: Zafer Hocam göreve çıktım gifteki gibi çalisrsa sorun yok sabah. Deneyip size haber vereyim.  Özelden mesaj yazamadığım için burdan bilgi veririm

---

(20/11/2020, 01:09)feraz yazdı: If Cells(Target.Row, 2).Value <> " " And Len(Cells(Target.Row, 2).Value + 0) <> 6 Then Exit Sub
Boş hücreler için yukardaki  " " gibi yaptım önceden "" imiş.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Açýklama_Ekleme As Comment

Dim strText



If Target.Column > 37 Then Exit Sub

If IsNumeric(Cells(Target.Row, 2).Value) = False 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

---

(20/11/2020, 01:07)hayalibey yazdı: Zafer Hocam hızlı olan kodun altına 5li imza blogundaki isimleri imza için açsa
Ama illa her zaman 5 kişi imzalayacak diye bir kural yok . 4 veya 3 te olabilir

Konu karıştı galiba

Evet hocam karıştırdım özür dilerim

İyi görevler abey.Deneyin olmazsa akşama bakabilirim.Bence oldu.