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
Comment Açıklama Bilgisi Kodunu Revize Etmek
If IsNumeric(Cells(Target.Row, 2).Value) = False Then Exit SubResimde 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.Son kodu denedinizmi Gif i izledinizmi?
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
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
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ş.
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çsaKonu karıştı galiba
Ama illa her zaman 5 kişi imzalayacak diye bir kural yok . 4 veya 3 te olabilir
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 SubEvet hocam karıştırdım özür dilerim
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çsaKonu karıştı galiba
Ama illa her zaman 5 kişi imzalayacak diye bir kural yok . 4 veya 3 te olabilir
Son Düzenleme: 20/11/2020, 01:11, Düzenleyen: hayalibey.
(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 SubEvet hocam karıştırdım özür dilerim
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çsaKonu karıştı galiba
Ama illa her zaman 5 kişi imzalayacak diye bir kural yok . 4 veya 3 te olabilir
İyi görevler abey.Deneyin olmazsa akşama bakabilirim.Bence oldu.
Konuyu Okuyanlar: 10 Ziyaretçi
