Страницы: 1
RSS
Запись любых измнений в книге на лист LOG
 
Друзья, добрый день.

На просторах интернета я нашел макрос, который записывает любые измнение в книге на лист 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
 
1. сохраните файл
2. выгрузите Excel
3. загрузите Excel
4. загрузите свой файл, радуйтесь изменениям, которые снова пишутся в лог
5. не пишите (не используйте) кривые макросы
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
2. выгрузите Excel3. загрузите Excel
Что значит выгрузить эксель и загрузить?
 
выгрузить - значит закрыть
загрузить - снова открыть)
удачи!

и перепишите фрагмент:
Код
    Application.ScreenUpdating = True: Application.EnableEvents = True
 
Exit Sub
Er1:
End Sub
вот так
Код
Er1:
    Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub
Изменено: Ігор Гончаренко - 29.09.2020 18:13:24
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, спасибо)
 
Цитата
Ігор Гончаренко написал:
и перепишите фрагмент:
кстати, в оригинальной версии кода этого фрагмента нет...отсюда и проблемы
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Страницы: 1
Наверх