Друзья, добрый день.
На просторах интернета я нашел макрос, который записывает любые измнение в книге на лист LOG.
Проблема в том, что если возникает ошибка в макросе он может перестать работатьв дальнейшем, даже если причина ошибки устранена.Даже если я потом просто меняю одну ячейку, а не массив.
Подскажите, пожалуйста, почему private sub может перестать работать в книге.
И второй вопрос, макрос всегда записывает данные на листе LOG по принципу последняя строка на которой он писал+1, например, последнее изменение макрос записал на строке 13 в листе LOG, даже если я очищу записи LOG, он продолжит все равно писать с ячейки 14 и т.д. Как это возможно исправить?
На просторах интернета я нашел макрос, который записывает любые измнение в книге на лист LOG.
Проблема в том, что если возникает ошибка в макросе он может перестать работатьв дальнейшем, даже если причина ошибки устранена.Даже если я потом просто меняю одну ячейку, а не массив.
Подскажите, пожалуйста, почему private sub может перестать работать в книге.
И второй вопрос, макрос всегда записывает данные на листе LOG по принципу последняя строка на которой он писал+1, например, последнее изменение макрос записал на строке 13 в листе LOG, даже если я очищу записи LOG, он продолжит все равно писать с ячейки 14 и т.д. Как это возможно исправить?
Код |
---|
Option Explicit Public sValue As String Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) On Error GoTo Er1 If Sh.Name = "LOG" Then Exit Sub Dim sLastValue As String Dim lLastRow As Long With Sheets("LOG") lLastRow = .Cells.SpecialCells(xlLastCell).Row + 1 If lLastRow - 1 = Rows.Count Then Exit Sub Application.ScreenUpdating = False: Application.EnableEvents = False .Cells(lLastRow, 70) = CreateObject("wscript.network").UserName .Cells(lLastRow, 71) = Target.Address(0, 0) .Cells(lLastRow, 72) = Format(Now, "dd.mm.yyyy HH:MM:SS") .Cells(lLastRow, 73) = Sh.Name .Cells(lLastRow, 74).NumberFormat = "@" .Cells(lLastRow, 75) = sValue If Target.Count > 1 Then Dim rCell As Range, rRng As Range On Error Resume Next Set rRng = Intersect(Target, Sh.UsedRange): On Error GoTo 0 If Not rRng Is Nothing Then For Each rCell In rRng If Not IsError(Target) Then sLastValue = sLastValue & "," & rCell Else sLastValue = sLastValue & "," & "Err" Next rCell sLastValue = Mid(sLastValue, 2) Else sLastValue = "" End If Else If Not IsError(Target) Then sLastValue = Target.Value Else sLastValue = "Err" End If .Cells(lLastRow, 76).NumberFormat = "@" .Cells(lLastRow, 76) = sLastValue End With Application.ScreenUpdating = True: Application.EnableEvents = True Exit Sub Er1: End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Sh.Name = "LOG" Then Exit Sub If Target.Count > 1 Then Dim rCell As Range, rRng As Range On Error Resume Next Set rRng = Intersect(Target, Sh.UsedRange): On Error GoTo 0 If rRng Is Nothing Then Exit Sub For Each rCell In rRng If Not IsError(rCell) Then sValue = sValue & "," & rCell Else sValue = sValue & "," & "Err" Next rCell sValue = Mid(sValue, 2) Else If Not IsError(Target) Then sValue = Target.Value Else sValue = "Err" End If End Sub |