Excel自动添加包含单元格编辑历史的注释

Question

我有以下的代码在"sheet macros"(右键点击表格 - 查看代码)中。它曾经可以运行，但现在它没有添加注释在我指定的范围A5:AQ155。

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

'If (Target.Row > 3 And Target.Row < 155) Then Cells(Target.Row, "AT") = Now()

Const sRng As String = "A5:AQ155" ' change as required
Dim sOld As String
Dim sNew As String
Dim sCmt As String
Dim iLen As Long
Dim bHasComment As Boolean


With Target(1)
If Intersect(.Cells, Range(sRng)) Is Nothing Then Exit Sub
sNew = .Text
sOld = .Text
.Value = sNew
Application.EnableEvents = True


sCmt = "Edit: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & Application.UserName & Chr(10) & "Previous Text :- " & sOld


If Target(1).Comment Is Nothing Then
.AddComment
Else
iLen = Len(.Comment.Shape.TextFrame.Characters.Text)
End If


With .Comment.Shape.TextFrame
.AutoSize = True
.Characters(Start:=iLen + 1).Insert IIf(iLen, vbLf, "") & sCmt
End With
End With
End Sub

我做错了什么？

- aduff

---

它对我有效。你是否逐行查看以确定它未按预期执行的位置。当我说它对我有效时，我的意思是它按照你的代码描述添加了一个注释。然而，它没有将旧文本添加到注释中。您需要使用“撤消”命令获取该信息，然后将其设置回输入的内容。 - Scott Holtzman

当像单元格编辑这样的事件被触发时，我该如何逐步运行类似于这样的宏？ - aduff

@user2836976 - 前往即时窗口并输入 Application.EnableEvents = True，然后再次运行代码。您还需要找到一个好的位置在您的代码中设置回来。由于这行代码的写法是 If Intersect(.Cells, Range(sRng)) Is Nothing Then Exit Sub，当用户在测试范围之外进行更改时，事件将永远不会重新启用，因此代码将永远不会触发。例如，在 If 块中添加一个 Else 并在 Else 结构中编写 Application.EnableEvents = True 和 Exit Sub。 - Scott Holtzman

只是提醒 - 你已经将其中一部分固定了，但请也对 Range 部分这样做！If Intersect(.Cells, Range(sRng)) Is Nothing Then Exit Sub 应该改为 If Intersect(.Cells, .Range(sRng)) Is Nothing Then Exit Sub。 - BruceWayne

@BruceWayne - 已添加 Me.range(sRng) 以回答问题。仅使用 .range(sRng) 导致脚本无法运行。 - aduff

Answer 1

由于禁用了事件触发器且未被重新启用，代码停止触发。代码的编写方式是，只要有人在范围A5:AQ155之外更改工作表，事件就会被禁用而不会被重新启用，这意味着后续的事件触发器将不会被触发（例如，下次编辑单元格时）。

如果您对代码进行了微调，它应该可以顺利运行。

但是，在执行这些微调之前，请在立即窗口中输入 Application.EnableEvents = True 并按 Enter 键重新启用事件，以使代码重新开始触发。

Private Sub Worksheet_Change(ByVal Target As Range)

Const sRng As String = "A5:AQ155" ' change as required
Dim sOld As String
Dim sNew As String
Dim sCmt As String
Dim iLen As Long

If Not Intersect(Target, Me.Range(sRng)) Is Nothing Then

    Application.EnableEvents = False

    With Target

        sNew = .Value2
        Application.Undo
        sOld = .Value2
        .Value2 = sNew

        Application.EnableEvents = True

        sCmt = "Edit: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & Application.UserName & Chr(10) & "Previous Text :- " & sOld


        If .Comment Is Nothing Then
            .AddComment
        Else
            iLen = Len(.Comment.Shape.TextFrame.Characters.Text)
        End If

        With .Comment.Shape.TextFrame
            .AutoSize = True
            .Characters(Start:=iLen + 1).Insert IIf(iLen, vbLf, "") & sCmt
        End With

    End With

End If

End Sub

- Scott Holtzman

---

当我尝试使用这段代码时，每当我编辑一个单元格时，它会在添加注释之前恢复到先前的单元格内容。 - aduff

@user2836976 - 抱歉，.Value2 = sOld 应该改为 .Value2 = sNew。我已经修复了。现在请再试一次。 - Scott Holtzman

嗨，Scott。那正是我要找的，但如果这是单元格的第一个条目，我不想添加评论。我想从第二个条目开始跟踪更改。我该怎么做？ - Sameh

我还注意到，一旦我在单元格中输入一个值，就无法执行“撤消（Undo）”操作。 - Sameh

@Sameh - 对于第一个问题，您可以通过检查Len(sOld)来确定更改前的值是否为空。对于第二个问题，当代码更改单元格时，“撤消”功能将无法使用。如果您想要，可以存储旧值并包括一个还原按钮，以将其重置为旧值。 - Scott Holtzman

Answer 2

这是最终的代码，它让我得到了期望的行为。我根据@Scott Holtzman的评论更改了第一个IF语句。现在，在使用End Sub结束宏之前，IF语句会重置Application.EnableEvents = True。

编辑：在“Me.range(sRng)”中包含“Me.”

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

'If (Target.Row > 3 And Target.Row < 155) Then Cells(Target.Row, "AT") = Now()

Const sRng As String = "A5:AQ155" ' change as required
Dim sOld As String
Dim sNew As String
Dim sCmt As String
Dim iLen As Long
Dim bHasComment As Boolean


With Target(1)
If Intersect(.Cells, Me.Range(sRng)) Is Nothing Then
Application.EnableEvents = True
Exit Sub
End If
sNew = .Text
sOld = .Text
.Value = sNew
Application.EnableEvents = True


sCmt = "Edit: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & Application.UserName & Chr(10) & "Previous Text :- " & sOld


If Target(1).Comment Is Nothing Then
.AddComment
Else
iLen = Len(.Comment.Shape.TextFrame.Characters.Text)
End If


With .Comment.Shape.TextFrame
.AutoSize = True
.Characters(Start:=iLen + 1).Insert IIf(iLen, vbLf, "") & sCmt
End With
End With
End Sub

Sub Hide_Comments_in_Workbook_Completely()
'This macro hides the comments and comment indicators - users wont know there is a comment within the excel workbook

Application.DisplayCommentIndicator = xlNoIndicator

End Sub

- aduff