Страницы: 1
RSS
Макрос для записи ЛОГ изменений ячеек в txt файл по всей книге не работает в ThisWorkbook, Если вставить, как есть то ничего не происходит.
 

Доброго времени суток.

Макрос создает файл LOG.txt в корне где пишет изменения.

Для того чтоб работал нужно прописывать в каждый лист, а можно ли сделать чтоб работал для всех листов. Если вставить, как есть то ничего не происходит.

Очень благодарен

Код
Private Sub Worksheet_Change(ByVal Target As Range)

    ActiveSheet.Calculate
  Close #1
    filepath = ThisWorkbook.Path & "\"
    'Filename = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & "_log.txt"
    Filename = "LOG_EXCEL.txt"
    Open filepath & Filename For Append As #1

  
    On Error Resume Next
    Print #1, Application.UserName; " " & Date & " " & Time & " "; ThisWorkbook.Name & " "; ActiveSheet.Name & "   " & " cell " & Target.Address & " : ;ñòàðå = ;[" & original & "], íîâå = ;[" & Target.Value & "]"
    On Error Resume Next
    Close #1
    original = Target.Text
End Sub

Изменено: qweewert - 27.12.2017 14:53:46
qweewert
 
ДА, можно
Есть событие  Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) в модуле "Эта Книга"
 
Но я думаю что не правильно обрабатывать такую задачу в событии Change. Т.к. код в обработчике события должен максимально быстро выполниться. А Процесс записи в файл это долгий процесс. Я бы порекомендовал делать запись в массив или коллекцию, а потом массово записывать в файл, по таймеру или по команде пользователя
 
Вообще бейсик буферизует запись в файл, и ОС тоже может буферизовать. Тут есть другие вопросы к коду:
1. Зачем каждый раз открывать и закрывать файл? Логичнее открыть по Workbook_Open, закрыть по Workbook_BeforeClose;
2. Просматривается попытка получить предыдущее значение ячейки, но в таком виде не работает;
3. Если измененный диапазон содержит более одной ячейки, значение не будет записано.
 
Не работает так
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
в модуле "Эта Книга"
Массово не подходит, тут фишка что текстовой файл сохраняется сразу мгновенно без задержки.
qweewert
 

Я таким способом мониторю изменения в файл и если что-то случилось я смогу посмотреть последние значения или использовать как резервную копию.

Плюс в том что запись происходит незаметно.

1. если файл не сохранится я могу посмотреть все что вводил до этого. У меня бил случай когда ни файл ни копия которая создается через vba не сохранилось и тога я нашел этот макрос и проблема пропала, если что я могу посмотреть кто что и когда менял.

2. Работает но только если макрос в листе

3. это я обхожу вытягиваем значений с ячеек через форму

Код
Private Sub EditList_Click()
'Dim lLastRow As Long
'   lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
'   If IsNumeric(Cells(lLastRow, 1)) Then _
'Cells(lLastRow + 1, 1).Value = Cells(lLastRow, 1).Value + 1 Else _
'Oae eonie oi aeua aiaaaey? a inoaii?e ?yaie oaaeeo? oaeno
Cells(myRow, 2).Resize(, 10) = Array(CDate(Me.MyDate), exp.Value, inc.Value, _
  gru.Value, pgr.Value, cat.Value, pca.Value, , , Opys.Value)
Close #1
    filepath = ThisWorkbook.Path & "\"
    'Filename = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & "_log.txt"
    Filename = "LOG_EXCEL.txt"
    Open filepath & Filename For Append As #1
 On Error Resume Next
    Print #1, Application.UserName; " " & Date & " " & Time & " "; ThisWorkbook.Name & " "; ActiveSheet.Name & "   " & ActiveCell.Address; ";", _
    ; Me.MyDate & ";" _
    ; exp.Value & ";" & inc.Value & ";", _
    gru.Value & ";" & pgr.Value & ";" & cat.Value & ";" & pca.Value & " ;" & " ;" & " ;" & Opys.Value
    On Error Resume Next
    Close #1
    original = Target.Text
'Cells(myRow, 6) = pgr.Value
'Opys.ValueClear
'Clear ia?aiao? ?enoeou aai? iiey ye? aea?ao aea ?iainu iai?ao??
EditMyForm.Hide
End Sub

Изменено: qweewert - 30.12.2017 16:13:26
qweewert
 
В коде еще больше пропусков не могли налепить?
Прошу исправить сообщение.
Страницы: 1
Наверх