Добавить имя листа в журнал изменений рабочего листа - PullRequest
0 голосов
/ 17 декабря 2018

Добрый день,

Я нашел этот код в Интернете, чтобы создать журнал изменений, и я хочу применить его к нескольким листам.Как заставить его тянуть название листа, где была изменена ячейка?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strAddress As String
Dim val
Dim dtmTime As Date
Dim Rw As Long

If Intersect(Target, Range("A:Z")) Is Nothing Then Exit Sub
   'change range to suit
dtmTime = Now()
With Target
      val = .Value
       strAddress = .Address
End With

Rw = Sheets("Log").Range("A" & Rows.Count).End(xlUp).Row + 1
With Sheets("Log")
    .Cells(Rw, 1) = strAddress
    .Cells(Rw, 2) = Environ("UserName")
    .Cells(Rw, 3) = dtmTime
    .Cells(Rw, 4) = val

End With
End Sub

1 Ответ

0 голосов
/ 17 декабря 2018

Прекратите использование нескольких подпрограмм события Worksheet_Change и переключитесь на один Workbook_Sheetchange в листе частного кода ThisWorkbook.

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Select Case LCase(Sh.Name)
        Case "sheet1", "sheet2", "sheet3"
            If Not Intersect(Target, Sh.Range("A:Z")) Is Nothing Then
                On Error GoTo exit_out
                Application.EnableEvents = False
                Dim rw As Long, t As Range
                For Each t In Intersect(Target, Sh.Range("A:Z"))
                    With Worksheets("Log")
                    rw = Worksheets("Log").Range("A" & Rows.Count).End(xlUp).Row + 1
                        .Cells(rw, "A") = t.Address(0, 0)
                        .Cells(rw, "B") = Environ("UserName")
                        .Cells(rw, "C") = Now
                        .Cells(rw, "D") = t.Value
                        .Cells(rw, "E") = Sh.Name
                    End With
                Next t
            End If
        Case "log"
            'do nothing
    End Select

exit_out:
    Application.EnableEvents = True

End Sub
...