Hocam boş olan hücrelerin karşısındaki hücrelerde bile inputbox açılıyor.
Hocam bir de inputboxun içeriğini temizleyip tamam diyince malesef commenti silmiyor önceki açıklama devam ediyor ancak boşluk bırakırsam comment boşluk olark değişiyor
Benim istediğim comment için inputbox bosaltilinca aciklama tamamen silinsin kırmızı tik kaybolsun
If IsNumeric(Cells(Target.Row, 2).Value) = False Then Exit Sub
Resimde boyadığım yere bu kodu ekleyin son koda.
(20/11/2020, 01:00)hayalibey yazdı: Hocam boş olan hücrelerin karşısındaki hücrelerde bile inputbox açılıyor.
Hocam bir de inputboxun içeriğini temizleyip tamam diyince malesef commenti silmiyor önceki açıklama devam ediyor ancak boşluk bırakırsam comment boşluk olark değişiyor
Benim istediğim comment için inputbox bosaltilinca aciklama tamamen silinsin kırmızı tik kaybolsun
Son kodu denedinizmi Gif i izledinizmi?
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
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
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