Açıklama eklemek

[M.ACAR]

İyi geceler forumdaki herkese

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.3, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 1.2, msoFalse, msoScaleFromTopLeft
Target.Comment.Visible = False
End If
End If
End Sub

Formülü daha önceden forumdan almıştım,Fakat benim bu formülün F3:G1000 arasında çalışması için üzerinde ne gibi değişiklik yapılması gerektiği konusunda yardıma ihtiyacım var

 

[Ömer]

Merhaba,

Bu şekilde denermisiniz..

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F3:G1000]) Is Nothing Then Exit Sub
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.3, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 1.2, msoFalse, msoScaleFromTopLeft
Target.Comment.Visible = False
End If
End Sub

.