• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Değişen Hücreye Açıklama Girme

Katılım
8 Ekim 2016
Mesajlar
2
Excel Vers. ve Dili
Office 2007 Türkçe
Makro ve kodlar konusunda yeniyim kendimi geliştirmeye çalışıyorum. Forumda aşağıdaki kodu buldum tam benim istediğim gibi bir kod ancak sadece A SATIRINDAKİ DEĞİŞİKLİKLERİ gösteriyor bu kodu tüm çalışma sayfasına veya kitabına göre nasıl uyarlayabilirim acaba. Şimdiden çok teşekkürler.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
say = ActiveSheet.Comments.Count
For i = 1 To say
ad = Split(Comments(i).Text, Chr(10))
If ad(0) = Target.Address Then
If Target.Value = "" Then
yazı = "Silindi"
Else
yazı = Target
End If
Comments(i).Visible = False
Comments(i).Text Text:=Target.Comment.Text & Chr(10) & Now & " " & "'" & yazı & "'"
a = True
Exit For
End If
Next
If a <> True Then
Target.AddComment
Target.Comment.Visible = True
Target.Comment.Text Text:=Target.Address & Chr(10) & Now & " " & "'" & Target & "'"
Target.Comment.Shape.Select
Selection.ShapeRange.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 1.8, msoFalse, msoScaleFromTopLeft
Target.Comment.Visible = False
End If
End If
End Sub
 
Merhaba,

VBA ekranındaki, "Bu çalışma kitabı" sayfasına kopyalayın.

Kod:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
say = ActiveSheet.Comments.Count
For i = 1 To say
ad = Split(ActiveSheet.Comments(i).Text, Chr(10))
If ad(0) = Target.Address Then
If Target.Value = "" Then
yazı = "Silindi"
Else
yazı = Target
End If
ActiveSheet.Comments(i).Visible = False
ActiveSheet.Comments(i).Text Text:=Target.Comment.Text & Chr(10) & Now & " " & "'" & yazı & "'"
a = True
Exit For
End If
Next
If a <> True Then
Target.AddComment
Target.Comment.Visible = True
Target.Comment.Text Text:=Target.Address & Chr(10) & Now & " " & "'" & Target & "'"
Target.Comment.Shape.Select
Selection.ShapeRange.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 1.8, msoFalse, msoScaleFromTopLeft
Target.Comment.Visible = False
End If
End Sub

.
 
Ömer Bey çok teşekkür ederim. Elinize sağlık
 
Geri
Üst