在复制/剪切/粘贴期间更改工作表以捕获所有单元格

时间:2019-04-09 21:42:17

标签: excel vba

我有一个代码,每次更改一个单元格时都会生成一条记录/注释,但是粘贴多个单元格时,它们并不会执行相同的操作。如何获取此代码以添加注释,无论是单独更改还是在多单元格粘贴功能中更改的任何单元格?

Private Sub Worksheet_Change(ByVal Target As Range)

    Const xRg As String = "A1:Z1000"
    Dim strOld As String
    Dim strNew As String
    Dim strCmt As String
    Dim xLen As Long
    With Target(1)
        If Intersect(.Cells, Range(xRg)) Is Nothing Then Exit Sub
        strNew = .Text
        ActiveSheet.Unprotect Password:="test"
        Application.EnableEvents = False

        strOld = .Text
        .Value = strNew
        Application.EnableEvents = True
        strCmt = "Edit: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & _
        Application.UserName & Chr(10) & "Previous Text :- " & strOld
        If Target(1).Comment Is Nothing Then

            .AddComment

        Else

            xLen = Len(.Comment.Shape.TextFrame.Characters.Text)

        End If
        With .Comment.Shape.TextFrame
            .AutoSize = True
            .Characters(Start:=xLen + 1).Insert IIf(xLen, vbLf, "") & strCmt
        End With
    End With
    ActiveSheet.Protect Password:="test"
End Sub

0 个答案:

没有答案