Учет времени активности открытой книги

[Grishek]

Всем привет.
Думаю данная тема будет всем актуальна.

Для целей личного тайм-менеджмента нужно понимать, сколько уходит времени на работу с определенным файлом.
Казалось все просто.
Но есть нюансы.
Работаю одновременно с многими книгами, но основное время трачу на одну книгу примерно % 70 всего времени.
Помогите, пожалуйста, дописать макрос.
Работает если активировать отдельно макрос, но не работает при открытии и закрытии.
Не могу придумать как привязать ко всем открывающимся книгам и активацию / деактивацию книги с учетом всех остальных открытых книг.

Private Sub WorkbookOpen()
lastrow = Worksheets("Time").Range("A60000").End(xlUp).Row
Worksheets("Time").Cells(lastrow + 1, 1) = Environ("USERNAME")
Worksheets("Time").Cells(lastrow + 1, 2) = Now
Worksheets("Time").Cells(lastrow + 1, 4) = ActiveWorkbook.Name
End Sub

Private Sub WorkbookClose()
lastrow = Worksheets("Time").Range("A60000").End(xlUp).Row
If lastrow > 1 Then Worksheets("Time").Cells(lastrow, 3) = Now
ActiveWorkbook.Save
End Sub

[pashulka]

Работает если активировать отдельно макрос, но не работает при открытии и закрытии.

Для того, чтобы макрос запускался автоматически после открытия и перед закрытием книги, в т.ч. и программно, можно использовать соответствующие события (см.далее), которые нужно разместить строго в модуле книги - ThisWorkbook(ЭтаКнига)

Код: Выделить всё

Private Sub Workbook_Open()

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

End Sub

Не могу придумать как привязать ко всем открывающимся книгам и активацию / деактивацию книги с учетом всех остальных открытых книг.

Для этого также есть свои события, а именно :

Код: Выделить всё

Private Sub Workbook_Activate()

End Sub

Private Sub Workbook_Deactivate()

End Sub

Если же нужно отслеживать действия со всеми книгами, то можно воспользоваться личной книгой макросов (Personal.xls) и использовать события приложения (где Wb это книга)

Код: Выделить всё

Private WithEvents xlApp As Excel.Application

Private Sub Workbook_Open()
    Set xlApp = Application
End Sub

'Private Sub xlApp_WorkbookOpen(ByVal Wb As Workbook)
'
'End Sub
'
'Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
'
'End Sub

Private Sub xlApp_WorkbookActivate(ByVal Wb As Workbook)

End Sub

Private Sub xlApp_WorkbookDeactivate(ByVal Wb As Workbook)

End Sub

P.S. Eсли Вас волнует совместимость версий, то количество строк можно указать не только как константу (Excel 97-2003 = 65536, 2007 = 1048576) но и просто Rows.Count

[Grishek]

Если же нужно отслеживать действия со всеми книгами, то можно воспользоваться личной книгой макросов (Personal.xls) и использовать события приложения (где Wb это книга) [/B]

Да, необходимо чтоб было отображено время открытия /закрытия каждого файла
+
регистрация времени активации и деактивации каждой открытой книги.

Пожалуйста, помогите собрать все в кучу ))

[pashulka]

Разместить весь нижеопубликованный код в модуле ThisWorkbook(ЭтаКнига) личной книги макросов Personal.xls

Код: Выделить всё

'Пример создания отчёта в первом рабочем листе

Private WithEvents xlApp As Excel.Application

Private Sub Workbook_Open()
    Set xlApp = Application
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ThisWorkbook.Save 'Me.Save
End Sub

Private Sub xlApp_WorkbookOpen(ByVal Wb As Workbook)
    SpyManager Wb, "Open"
End Sub

Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
    SpyManager Wb, "Close"
End Sub

Private Sub xlApp_WorkbookActivate(ByVal Wb As Workbook)
    SpyManager Wb, "Activate"
End Sub

Private Sub xlApp_WorkbookDeactivate(ByVal Wb As Workbook)
    SpyManager Wb, "Deactivate"
End Sub

Private Sub SpyManager(Wb As Workbook, WbEvent As String)
    With ThisWorkbook.Worksheets(1)
         With .Cells(.Rows.Count, 1).End(xlUp)
              .Offset(1, 0) = Environ("UserName") 'Application.UserName
              .Offset(1, 1) = Now
              .Offset(1, 2) = WbEvent
              .Offset(1, 3) = Wb.Name
         End With
    End With
End Sub

[Grishek]

Премного благодарен!
Все отлично работает, даже лучше чем было задумано мной)

[Grishek]

Разместить весь нижеопубликованный код в модуле ThisWorkbook(ЭтаКнига)

Немного подкорректировал.
не получается добавить формулу, подскажите пожалуйста, в чем проблема?


Private WithEvents xlApp As Excel.Application

Private Sub Workbook_Open()
Set xlApp = Application
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Save
End Sub

Private Sub xlApp_WorkbookOpen(ByVal Wb As Workbook)
SpyManager Wb, "Open"
End Sub

Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
SpyManager Wb, "Close"
End Sub

Private Sub xlApp_WorkbookActivate(ByVal Wb As Workbook)
SpyManager Wb, "Activate"
End Sub

Private Sub xlApp_WorkbookDeactivate(ByVal Wb As Workbook)
SpyManager_d Wb, Time

End Sub
Private Sub SpyManager_d(Wb As Workbook, WbEvent As String)
With ThisWorkbook.Worksheets(1)
With .Cells(.Rows.Count, 1).End(xlUp)

.Offset(0, 4) = WbEvent
.Offset(0, 5) = ActiveCell.FormulaR1C1 = "=SUM(RC[-1],-RC[-2])"

End With
End With
End Sub
Private Sub SpyManager(Wb As Workbook, WbEvent As String)
With ThisWorkbook.Worksheets(1)
With .Cells(.Rows.Count, 1).End(xlUp)
.Offset(1, 0) = Application.UserName
.Offset(1, 1) = WbEvent
.Offset(1, 2) = Date
.Offset(1, 3) = Time
.Offset(1, 6) = Wb.Name
.Offset(1, 7) = Wb.ActiveSheet.Name

End With
End With
End Sub

[pashulka]

Зачем три километра кода, если ошибка в одной строке

Код: Выделить всё

.Offset(0, 5).FormulaR1C1 = "=RC[-1]-RC[-2]"

Код: Выделить всё

.Offset(0, 5).FormulaR1C1 = "=SUM(RC[-1],-RC[-2])"

[Grishek]

[quote="pashulka"]Зачем три километра кода, если ошибка в одной строке

Супер!
Пока не настолько умен )) как Вы.
Благодарю!

[Grishek]

[quote="pashulka"]Зачем три километра кода, если ошибка в одной строке

Добрый день,
Скажите пожалуйста, Вы не практикуете обучение VBA?

[pashulka]

Нет.
Но для самостоятельного изучения VBA могу посоветовать - не стесняться использовать макрорекордер (запись макроса) и офисную справку.