'Вводим глобальные переменные для использования во всём документе
Public xl0 As New Excel.Application
Public xlw As New Excel.Workbook
Public endtime As Double
Public session_active As Boolean
Public log_file As String
Public timer_time As Date
Public SaveAS_Check As Boolean

Sub Write_Start() 'Заносим начало сессии
    'Вставляем новую вторую строку и копируем форматы снизу:
    xlw.Worksheets("LOG").Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    'Заносим имя пользователя, имя файла, путь к файлу и дату-время начала сессии:
    xlw.Worksheets("LOG").Cells(2, 1) = Format(Now, "dd.mm.yyyy")
    xlw.Worksheets("LOG").Cells(2, 2) = Environ("USERNAME")
    xlw.Worksheets("LOG").Cells(2, 3) = ThisWorkbook.Name
    xlw.Worksheets("LOG").Cells(2, 4) = ThisWorkbook.Path
    xlw.Worksheets("LOG").Cells(2, 5) = Format(Now, "dd.mm.yyyy hh:mm:ss")
End Sub

'Функция поиска строки в логе
Function FindMatch(x, y, z)
    Const FirstRow = 2
    Dim LastRow As Long
    Dim CurRow As Long
    With xlw.Worksheets("LOG")
        LastRow = .Range("B:C").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For CurRow = FirstRow To LastRow
            If .Range("B" & CurRow).Value = x And .Range("C" & CurRow).Value = y And .Range("D" & CurRow).Value = z Then
                FindMatch = CurRow
                Exit Function
            End If
        Next CurRow
    End With
    ' Если не находит строки
    FindMatch = "NO_SESSION"
End Function

Sub Write_Close() 'Заносим время окончания и разницу во времени
    Row_Number = FindMatch(Environ("USERNAME"), ThisWorkbook.Name, ThisWorkbook.Path)
    If Row_Number = "NO_SESSION" Then
        MsgBox "Такая сессия отсутсвует в логе! Данные не записаны!!!"
        Else
        xlw.Worksheets("LOG").Cells(Row_Number, 6) = Format(Now, "dd.mm.yyyy hh:mm:ss")
        xlw.Worksheets("LOG").Cells(Row_Number, 7) = "=F" & Row_Number & "-E" & Row_Number
    End If
End Sub

Sub Start_Session() 'Открываем новую сессию
    'Открываем файл лога в отдельной программе excel
    Set xlw = xl0.Workbooks.Open(log_file)
    'Вызываем саб записи
    Call Write_Start
    'Сохраняем и закрываем лог файл:
    xlw.Save
    xlw.Close
    session_active = True
End Sub

Sub Close_Session() 'Закрываем последнюю сессию
    'Открываем файл лога в отдельной программе excel
    Set xlw = xl0.Workbooks.Open(log_file)
    'Вызываем саб записи
    Call Write_Close
    'Сохраняем и закрываем лог файл:
    xlw.Save
    xlw.Close
    session_active = False
End Sub

Sub Save_Session() 'Сохраняем сессию не закрывая ее
    'Открываем файл лога в отдельной программе excel
    Set xlw = xl0.Workbooks.Open(log_file)
    'Вызываем саб записи
    Call Write_Close
    'Сохраняем и закрываем лог файл:
    xlw.Save
    xlw.Close
End Sub

Sub Workbook_Open() 'Действия при открытии книги
    'Определяем путь к лог файлу
    log_file = "ПУТЬ К ФАЙЛУ ЛОГА"
    'Определяем время таймера завершения сессии
    timer_time = "00:08:00"
    'Начинаем новую сессию
    Call Start_Session
    'Запускаем таймер
    endtime = Now + TimeValue(timer_time)
    Application.OnTime endtime, "Close_Session"
    'Для корректной работы при сохранении
    SaveAS_Check = False
End Sub

Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    'После каждого последнего выделения новой ячейки
    'Убиваем все активные Application.OnTime
    On Error Resume Next
    Application.OnTime endtime, "Close_Session", , False
    If session_active = True Then
        'Если сессия активна - начинаем обратный отсчёт, если время выходит - идем закрывать сессию
        endtime = Now + TimeValue(timer_time)
        Application.OnTime endtime, "Close_Session"
        Else
        'если сессия не активна - начинаем новую и начинаем обратный отсчёт
        Call Start_Session
        endtime = Now + TimeValue(timer_time)
        Application.OnTime endtime, "Close_Session"
    End If
End Sub

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    'Закрытие сессии при сохранении книги
    If session_active = True Then
        Call Save_Session
    End If
    'Проверка на СохранитьКак
    If SaveAsUI Then
        SaveAS_Check = True
    End If
End Sub

Sub Workbook_AfterSave(ByVal Success As Boolean)
    'Создание новой сессии если СохранитьКак
    If SaveAS_Check = True Then
        Call Start_Session
        SaveAS_Check = False
    End If
End Sub
 
Sub Workbook_BeforeClose(Cancel As Boolean)
    'Убиваем все активные Application.OnTime чтобы файл не переоткрылся и не было лишних записей
    On Error Resume Next
    Application.OnTime endtime, "Close_Session", , False
    'Закрываем сессию если активна
    If session_active = True Then Close_Session
End Sub