AccessTr.neT
Comment Açıklama Bilgisi Kodunu Revize Etmek - Baskı Önizleme

+- 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)

Sayfalar: 1 2 3 4 5 6 7


Comment Açıklama Bilgisi Kodunu Revize Etmek - hayalibey - 18/11/2020

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 




RE: Comment Açıklama Bilgisi Kodunu Revize Etmek - feraz - 19/11/2020

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



RE: Comment Açıklama Bilgisi Kodunu Revize Etmek - hayalibey - 19/11/2020

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


RE: Comment Açıklama Bilgisi Kodunu Revize Etmek - feraz - 19/11/2020

(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.


RE: Comment Açıklama Bilgisi Kodunu Revize Etmek - hayalibey - 19/11/2020

Tamam Zafer Hocam akşama size de uygunsa bakalim


RE: Comment Açıklama Bilgisi Kodunu Revize Etmek - hayalibey - 19/11/2020

Zafer Hocam siz uygunsanız ben uzak bağlantı için uygunum