Добавить имя листа в журнал изменений рабочего листа

Добрый день,

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

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
.Cells(Rw, 5) = me.Name
Scott Craner 17.12.2018 18:37
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
1
1
231
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Прекратите использовать несколько подпрограмм событий 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

Хорошо сделано! Отличная обработка ошибок для Application.EnableEvents. Слишком много людей не справляются с этим правильно, и приятно видеть, что кто-то делает это правильно.

Frank Ball 17.12.2018 21:18

Другие вопросы по теме