Skip to main content

AccessTr.neT


Comment Açıklama Bilgisi Kodunu Revize Etmek

Comment Açıklama Bilgisi Kodunu Revize Etmek

#7
Saat 23:00 gibi olabilir.Yada sonuç nasıl çıkacak onu gösterirseniz daha iyi olur.
Cevapla
#8
Zafer Hocam açıklama için bakma imkanınız var mı  acaba
.rar Puantaj_Comment.rar (Dosya Boyutu: 393,33 KB | İndirme Sayısı: 1)
Cevapla
#9
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
Cevapla
#10
Hocam özel mesaj atamıyorum
Cevapla
#11
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
Son Düzenleme: 19/11/2020, 23:29, Düzenleyen: hayalibey.
Cevapla
#12
(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.

[Resim: do.php?img=10598]

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
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da