Skip to main content

AccessTr.neT


Comment Açıklama Bilgisi Kodunu Revize Etmek

Comment Açıklama Bilgisi Kodunu Revize Etmek

Çözüldü #1
Merhaba herkese
Aşağıdaki kod ile hangi hücreyi tıklarsam açıklama ekleyebiliyorum. Ama açıklama var olan hücreyi tıkladığımda mevcut açıklama gelmiyor inputbox boş geliyor .
Benim yapamadığım B2:B aralığında 6 haneli rakam olmak şartı ile b2 b aralığında 6 haneli rakam bulunan satırların B:AK Satır aralığına tıklarsam inputbox açılsın başka aralık ta açılmasın
Bir de hücrede açıklama var isevi hücreye tıkladığımda inputbox mevcut açıklamayı mutlaka göstersin. Değiştirmek istersem ben inputbox içindeki metni silip yenisini yazayım.
Yardım edebilecek olan varsa çok sevinirim .
Kod:
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Açıklama_Ekleme As Comment

Dim strText As String

a = 2

If Cells(a, 1) > 0 Then

  strText = Application.InputBox("Eklenecek olan mesajı aşağıya yazınız.", _

    "Açıklama_Ekleme", "Açıklama Ekler", , , , 2)

         If Application.ExecuteExcel4Macro("Get.Cell(46)") = True Then

    ActiveCell.Comment.Delete

      End If

  ActiveCell.AddComment

  Set Açıklama_Ekleme = ActiveCell.Comment

    With Açıklama_Ekleme

      .Text Text:=strText

      With .Shape.TextFrame.Characters.Font

        .Name = "Arial"

        .Size = 8

        .Bold = False

      End With

    End With

    End If

End Sub 

.rar Comment Açıklama Bilgisi.rar (Dosya Boyutu: 12,09 KB | İndirme Sayısı: 1)
Cevapla
#2
A sütunundaki veri uzunluk 6 ise işlem yapar.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Açýklama_Ekleme As Comment
Dim strText As String


If Target.Column > 37 Then Exit Sub
If Len(Cells(Target.Row, 1)) <> 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
#3
Zafer Hocam B sütunu 6 karekter olunca olması gerekiyor.
If Len(Cells(Target.row, 1 ))  satırını 2 yaptim.
Ama arada takılıyor
Mevcut eski açıklama bilgisi geliyor tıklayınca silince açıklamada silinmiyor
Değiştirince yeni yazılanı eklemiyor
Ocak ayı sayfasında denedim olmuyor Hocam ocak sayfasına ekledim
.rar PUANTAJ ÇALIŞMA 5.rar (Dosya Boyutu: 306,43 KB | İndirme Sayısı: 1)
Cevapla
#4
(19/11/2020, 13:25)hayalibey yazdı: Zafer Hocam B sütunu 6 karekter olunca olması gerekiyor.
If Len(Cells(Target.row, 1 ))  satırını 2 yaptim.
Ama arada takılıyor
Mevcut eski açıklama bilgisi geliyor tıklayınca silince açıklamada silinmiyor
Değiştirince yeni yazılanı eklemiyor
Ocak ayı sayfasında denedim olmuyor Hocam ocak sayfasına ekledim
Akşama bakayım abey.Sonuç olarak excelde gösterin bence.
Cevapla
#5
Tamam Zafer Hocam akşama size de uygunsa bakalim
Cevapla
#6
Zafer Hocam siz uygunsanız ben uzak bağlantı için uygunum
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task