+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Comment Açıklama Bilgisi Kodunu Revize Etmek (/konu-comment-aciklama-bilgisi-kodunu-revize-etmek.html)
RE: Comment Açıklama Bilgisi Kodunu Revize Etmek - feraz - 19/11/2020
Saat 23:00 gibi olabilir.Yada sonuç nasıl çıkacak onu gösterirseniz daha iyi olur.
RE: Comment Açıklama Bilgisi Kodunu Revize Etmek - hayalibey - 19/11/2020
Zafer Hocam açıklama için bakma imkanınız var mı acaba
Re: Comment Açıklama Bilgisi Kodunu Revize Etmek - feraz - 19/11/2020
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 SubRE: Comment Açıklama Bilgisi Kodunu Revize Etmek - hayalibey - 19/11/2020
Hocam özel mesaj atamıyorum
RE: Comment Açıklama Bilgisi Kodunu Revize Etmek - hayalibey - 19/11/2020
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
RE: Comment Açıklama Bilgisi Kodunu Revize Etmek - feraz - 20/11/2020
(19/11/2020, 23:26)hayalibey yazdı: Bir de b sütunda 6 rakam denetlemesi yapmıyor malesefAlttaki kodun görevi zaten o.
If Cells(Target.Row, 2).Value <> "" And Len(Cells(Target.Row, 2).Value + 0) <> 6 Then Exit SubIf 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