В общем я всё сделал. Вышло очень круто. Если кому интересно и для тех кто попадёт сюда через гугл:
Цитата:
Назначение макроса:
Автоматическая фиксация активной работы в книге по принципу активных сессий. Запись проводится в отдельный файл лога с фиксацией пользователя, имени файла, пути к файлу, даты начала и конца сессии, длительности сессии.
Не зависит от того открыт ли файл только для чтения или редактируется.
Любая активность считается работой с файлом.
Длительность сессии ограничена по времени, по истечении которого завершается.
Поддерживает одновременную работу нескольких пользователей.
Проверка на наличие сессии в логе перед закрытием.
Триггеры:
Открытие книги:
- признание начала новой сессии
- запись информации по новой сессии в отдельный файл лога
- запуск таймера обратного отсчёта активности сессии (8 минут)
Истечение времени таймера обратного отсчёта:
- признание сессии завершенной
- запись информации по завершению сессии в отдельный файл лога
Выделение любой ячейки/группы ячеек:
- если сессия активна - перезапуск таймера обратного отсчёта
- если сессия завершена - признание начала новой сессии, запись информации по новой сессии в отдельный файл лога и запуск таймера обратного отсчёта
Сохранение книги:
- если сессия активна - запись информации по завершению сессии в отдельный файл лога, без завершения активности сессии. Несколько сохранений подряд не создают новых сессий, а лишь переписывают дату завершения сессии
- если сессия завершена - никаких действий"
Закрытие книги:
- если сессия активна - запись информации по завершению сессии в отдельный файл лога.
- остановка таймеров обратного отсчёта для избегания перезапуска excel файла
|
Код Module1:
Код:
'Вводим глобальные переменные для использования во всём документе
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
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) = "=F2-E2"
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
Код ThisWorkbook:
Код:
Sub Workbook_Open() 'Действия при открытии книги
'Определяем путь к лог файлу
log_file = "ПУТЬ К ФАЙЛУ ЛОГА"
'Определяем время таймера завершения сессии
timer_time = "00:08:00"
'Начинаем новую сессию
Call Start_Session
'Запускаем таймер
endtime = Now + TimeValue(timer_time)
Application.OnTime endtime, "Close_Session"
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
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
Структура лог файла:
Лист LOG и колонки A-G
Date-USER-FILENAME-FILEPATH-SESSION START-SESSION END-TIME, h
Так же лист сводной таблицы чтобы с этим работать и анализировать.
Нужно разово настроить форматы колонок.
10.06.2016, 22:29
Похожие темы
