Initial commit

VBAMake.txt

@@ -0,0 +1,54 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact_home, source_home
+
+id = Concept-Reports
+name = Всеучет
+description = Учет рабочего времени
+artifact_home = Всеучет
+source_home = Concept-Reports
+install_home = \\fs1.concept.ru\projects\10 Автоматизация деятельности\02 Офисная автоматизация\01 Всеучет
+
+%%
+# === Build section ===
+# Available commands:
+#   build LOCAL_MANIFEST
+#   copy LOCAL_SOURCE -> [LOCAL_ARTIFACT]
+#   save_as LOCAL_ARTIFACT -> LOCAL_ARTIFACT
+#   run LOCAL_SOURCE.bat
+
+copy distr\80 Учет рабочего времени.xltx
+copy distr\90 Ежемесячный отчет.xltx
+copy distr\Производственный календарь.xlsx
+copy distr\Примеры работ.xlsx
+
+build script\worker.txt
+build script\aggregator.txt
+build script\projects.txt
+
+save_as ConceptReport.xlsm -> ConceptReport.xlam
+
+%%
+# === Install section ==
+# Available commands:
+#	install LOCAL_ARTIFACT -> [INSTALL_PATH]
+#	add_template LOCAL_ARTIFACT -> [LOCAL_TEMPLATE]
+#   run LOCAL_ARTIFACT.bat <- [PARAMETERS]
+#	run APPLICATION <- [PARAMETERS]
+
+add_template 80 Учет рабочего времени.xltx
+add_template 90 Ежемесячный отчет.xltx
+install 80 Учет рабочего времени.xltx -> Шаблоны\80 Учет рабочего времени.xltx
+install 90 Ежемесячный отчет.xltx -> Шаблоны\90 Ежемесячный отчет.xltx
+
+install !Всеучёт.xlsm
+install !Список проектов.xlsm
+install Производственный календарь.xlsx
+install Примеры работ.xlsx
+
+install ConceptReport.xlam
+install ConceptReport.xlam -> \\fs1.concept.ru\Exchange\ConceptDistr\data\Add-ins\Excel\ConceptReport.xlam
+
+# manual update !Список проектов.xlsm -> \\fs1.concept.ru\Exchange\!Список проектов.xlsm
+# manual update !Всеучёт.xlsm -> \\fs1.concept.ru\projects\05 СОУ Концепт\05 Отчеты Сотрудников\!ВСЕУЧЁТ\!Всеучёт.xlsm

VERSION

@@ -0,0 +1 @@
+1.1.0

script/aggregator.txt

@@ -0,0 +1,89 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact
+
+name = !Всеучёт.xlsm
+artifact = !Всеучёт.xlsm
+
+%%
+# === Imports Section ===
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SharedHome path
+
+dev
+	DevTester.bas
+	ex_ConceptOrganization.bas
+
+api
+	ex_WinAPI.bas
+	
+	API_XLWrapper.cls
+	API_UserInteraction.cls
+	
+excel
+	ex_Excel.bas
+	
+utility
+	ex_VBA.bas
+	
+ui
+	CSE_ProgressBar.frm
+
+%%
+# === Source Code Section ==
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SourceHome path
+
+src
+	aggregator
+		CreateWorkerDlg.frm
+		
+		DevHelper.bas
+		
+		DataAccess.bas
+		Declarations.bas
+		Main.bas
+		MainImpl.bas
+		z_UIMessages.bas
+		z_UIRibbon.bas
+		
+		DB_GlobalWorks.cls
+		DB_Workers.cls
+		
+		ItemInputWorker.cls
+		IteratorGlobalWork.cls
+		IteratorWorker.cls
+		
+	common
+		DataTransfer.bas
+		DeclarationsWorker.bas
+		
+		DB_CachedProjects.cls
+		DB_WorkerData.cls
+		
+		ItemCachedProject.cls
+		IteratorWork.cls
+
+		
+%%
+# ===== UI Section =======
+# Pairs of path to UI elements, use " -> " delimiter
+# First component is a path relative to SourceHome\ui folders
+# Second component is internal path inside project file
+
+aggregator\.rels -> _rels\.rels
+aggregator\customUI.xml -> customUI\customUI.xml
+
+%%
+# === References Section ===
+# List dependencies in one of the formats
+# global : GLOBAL_NAME
+# guid : {REGISTERED_GUID}
+# file : PATH_TO_LIBRARY
+
+global : Scripting
+global : MSForms
+global : Shell32

script/projects.txt

@@ -0,0 +1,64 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact
+
+name = !Список проектов.xlsm
+artifact = !Список проектов.xlsm
+
+%%
+# === Imports Section ===
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SharedHome path
+
+dev
+	ex_ConceptOrganization.bas
+
+api
+	ex_WinAPI.bas
+	
+utility
+	ex_VBA.bas
+
+%%
+# === Source Code Section ==
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SourceHome path
+
+src
+	projects
+		DataAccess.bas
+		Declarations.bas
+		Main.bas
+		MainImpl.bas
+		
+		z_UIRibbon.bas
+		
+	common
+		DataTransfer.bas
+		
+		DB_Projects.cls
+		
+		IteratorProject.cls
+		
+
+%%
+# ===== UI Section =======
+# Pairs of path to UI elements, use " -> " delimiter
+# First component is a path relative to SourceHome\ui folders
+# Second component is internal path inside project file
+
+projects\.rels -> _rels\.rels
+projects\customUI.xml -> customUI\customUI.xml
+
+%%
+# === References Section ===
+# List dependencies in one of the formats
+# global : GLOBAL_NAME
+# guid : {REGISTERED_GUID}
+# file : PATH_TO_LIBRARY
+
+global : Scripting
+global : Shell32

script/worker.txt

@@ -0,0 +1,92 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact
+
+name = ConceptReport.xlsm
+artifact = ConceptReport.xlsm
+
+%%
+# === Imports Section ===
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SharedHome path
+
+dev
+	DevTester.bas
+	ex_ConceptOrganization.bas
+
+api
+	ex_WinAPI.bas
+	
+	API_XLWrapper.cls
+	API_UserInteraction.cls
+	
+excel
+	ex_Excel.bas
+	
+utility
+	ex_VBA.bas
+	ex_DataPreparation.bas
+	
+ui
+	CSE_ProgressBar.frm
+	
+	Calendar
+		CSE_Calendar.frm
+		z_CalendarUI.bas
+		CSE_CallbackCalendar.cls
+
+%%
+# === Source Code Section ==
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SourceHome path
+
+src
+	worker
+		DataAccess.bas
+		DevHelper.bas
+		Declarations.bas
+		Main.bas
+		MainImpl.bas
+		z_UIMessages.bas
+		z_UIRibbon.bas
+		
+		CRD_ProjectList.frm
+		CRD_NewYear.frm
+		CRD_WorkList.frm
+		
+		MonthlyReport.cls
+		
+	common
+		DataTransfer.bas
+		DeclarationsWorker.bas
+		
+		DB_CachedProjects.cls
+		DB_WorkerData.cls
+		
+		ItemCachedProject.cls
+		IteratorWork.cls
+		
+
+%%
+# ===== UI Section =======
+# Pairs of path to UI elements, use " -> " delimiter
+# First component is a path relative to SourceHome\ui folders
+# Second component is internal path inside project file
+
+worker\.rels -> _rels\.rels
+worker\customUI.xml -> customUI\customUI.xml
+
+%%
+# === References Section ===
+# List dependencies in one of the formats
+# global : GLOBAL_NAME
+# guid : {REGISTERED_GUID}
+# file : PATH_TO_LIBRARY
+
+global : Scripting
+global : MSForms
+global : Outlook
+global : Shell32

src/aggregator/CreateWorkerDlg.frm

@@ -0,0 +1,74 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CreateWorkerDlg 
+   Caption         =   "Äîáàâëåíèå ñîòðóäíèêà"
+   ClientHeight    =   2745
+   ClientLeft      =   45
+   ClientTop       =   435
+   ClientWidth     =   5385
+   OleObjectBlob   =   "CreateWorkerDlg.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "CreateWorkerDlg"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private workers_ As DB_Workers
+Public isCanceled_ As Boolean
+
+Private Sub UserForm_Initialize()
+  isCanceled_ = True
+  Call PositionInMiddle(Me)
+End Sub
+
+Public Function Init(iWorkers As DB_Workers)
+  isCanceled_ = True
+  Set workers_ = iWorkers
+End Function
+
+Public Property Get WorkerID() As String
+  WorkerID = TBWorkerID.Value
+End Property
+
+Public Property Get WorkerName() As String
+  WorkerName = TBWorkerName.Value
+End Property
+
+Public Property Get Path() As String
+  Path = TBPath.Value
+End Property
+
+Public Function GetUserInput() As ItemInputWorker
+  Dim iWorker As New ItemInputWorker
+  With iWorker
+    .path_ = Path
+    .workerID_ = WorkerID
+    .workerName_ = WorkerName
+  End With
+  Set GetUserInput = iWorker
+End Function
+
+' =======
+Private Sub BtnPath_Click()
+  Dim sFile$: sFile = UserInteraction.PromptFileFilter(ThisWorkbook.Path & "\", "Âûáåðèòå ôàéë", "*.xlsx")
+  If sFile = vbNullString Then _
+    Exit Sub
+  TBPath.Text = sFile
+End Sub
+
+Private Sub BtnOk_Click()
+  If workers_.Contains(WorkerID) Then
+    Call UserInteraction.ShowMessage(EM_WORKER_ALREADY_EXISTS, WorkerID)
+    Exit Sub
+  End If
+  
+  isCanceled_ = False
+  Call Me.Hide
+End Sub
+
+Private Sub BtnCancel_Click()
+   isCanceled_ = True
+   Call Me.Hide
+End Sub

src/aggregator/DB_GlobalWorks.cls

@@ -0,0 +1,87 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "DB_GlobalWorks"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private data_ As Excel.Worksheet
+Private projects_ As DB_CachedProjects
+
+Public Function Init(target As Excel.Worksheet, iProjects As DB_CachedProjects)
+  Set data_ = target
+  Set projects_ = iProjects
+End Function
+
+Public Function IBegin() As IteratorGlobalWork
+  Set IBegin = New IteratorGlobalWork
+  Call IBegin.Init(data_)
+End Function
+
+Public Function ILast() As IteratorGlobalWork
+  Set ILast = New IteratorGlobalWork
+  Call ILast.Init(data_)
+  Call ILast.GoLast
+End Function
+
+Public Function INew() As IteratorGlobalWork
+  Set INew = New IteratorGlobalWork
+  Call INew.Init(data_)
+  Call INew.GoLast
+  Call INew.Increment
+End Function
+
+Public Function Clear()
+  Call data_.UsedRange.Offset(1).ClearContents
+End Function
+
+Public Function ReloadDataFor(iWorker As IteratorWorker, iReport As Excel.Workbook, nStartDate&)
+  Dim sWorkerID$: sWorkerID = iWorker.WorkerID
+  Call RemoveDataFor(sWorkerID)
+  
+  Dim iData As DB_WorkerData: Set iData = AccessWorkerData(iReport)
+  Dim iWork As IteratorWork: Set iWork = iData.IBegin
+  Call iWork.GoUntil(nStartDate)
+  
+  Dim dHours As Double: dHours = 0
+  Dim out As IteratorGlobalWork: Set out = INew
+  Do While Not iWork.IsDone
+    Dim dDuration As Double: dDuration = iWork.Duration
+    If dDuration = 0 Then _
+      GoTo NEXT_WORK
+      
+    dHours = dHours + dDuration
+    With out
+      .Category = projects_.GetProjectCategory(iWork.Project)
+      .DDate = iWork.DDate
+      .Description = iWork.Description
+      .Duration = dDuration
+      .Project = iWork.Project
+      .WorkerID = sWorkerID
+      .WorkType = iWork.WorkType
+      .Year = VBA.Year(iWork.DDate)
+    End With
+    Call out.Increment
+    
+NEXT_WORK:
+    Call iWork.Increment
+  Loop
+  
+  iWorker.Hours = dHours
+End Function
+
+' ========
+Private Function RemoveDataFor(target$)
+  Dim iWork As IteratorGlobalWork: Set iWork = IBegin
+  Do While Not iWork.IsDone
+    If iWork.WorkerID = target Then
+      Call iWork.RemoveRow
+    Else
+      Call iWork.Increment
+    End If
+  Loop
+End Function

src/aggregator/DB_Workers.cls

@@ -0,0 +1,78 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "DB_Workers"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private data_ As Excel.Worksheet
+
+Public Function Init(target As Excel.Worksheet)
+  Set data_ = target
+End Function
+
+Public Property Get Count() As Long
+  Count = ILast.row_ - IBegin.row_ + 1
+End Property
+
+Public Property Get CountActive() As Long
+  Dim iter As IteratorWorker: Set iter = IBegin
+  Do While Not iter.IsDone
+    If iter.Active Then _
+      CountActive = CountActive + 1
+    Call iter.Increment
+  Loop
+End Property
+
+Public Function IBegin() As IteratorWorker
+  Set IBegin = New IteratorWorker
+  Call IBegin.Init(data_)
+End Function
+
+Public Function ILast() As IteratorWorker
+  Set ILast = New IteratorWorker
+  Call ILast.Init(data_)
+  Call ILast.GoLast
+End Function
+
+Public Function INew() As IteratorWorker
+  Set INew = New IteratorWorker
+  Call INew.Init(data_)
+  Call INew.GoLast
+  Call INew.Increment
+End Function
+
+Public Function Clear()
+  Call data_.UsedRange.Offset(1).ClearContents
+End Function
+
+Public Function Contains(sWorkerID$) As Boolean
+  Contains = Not Access(sWorkerID) Is Nothing
+End Function
+
+Public Function Access(sWorkerID$) As IteratorWorker
+  Dim iWorker As IteratorWorker: Set iWorker = IBegin
+  Do While Not iWorker.IsDone
+    If iWorker.WorkerID = sWorkerID Then
+      Set Access = iWorker
+      Exit Function
+    End If
+    Call iWorker.Increment
+  Loop
+End Function
+
+' Requires: Not Contains(sWorkerID)
+Public Function AddWroker(sWorkerID$, sWorkerName$, sPath$)
+  Dim iWorker As IteratorWorker: Set iWorker = INew
+  With iWorker
+    .Active = True
+    .WorkerID = sWorkerID
+    .Hours = 0
+    .WorkerName = sWorkerName
+    .ReportPath = sPath
+  End With
+End Function

src/aggregator/DataAccess.bas

@@ -0,0 +1,55 @@
+Attribute VB_Name = "DataAccess"
+Option Private Module
+Option Explicit
+
+Public Function GetStartDate() As Long
+  GetStartDate = ThisWorkbook.Names(CELL_DATE_START).RefersToRange
+End Function
+
+Public Function AccessWorkers() As DB_Workers
+  Static s_Workers As DB_Workers
+  
+  If s_Workers Is Nothing Then
+    Set s_Workers = New DB_Workers
+    Call s_Workers.Init(ThisWorkbook.Worksheets(SHEET_WORKERS))
+  End If
+  
+  Set AccessWorkers = s_Workers
+End Function
+
+Public Function AccessWorkerData(iSource As Excel.Workbook) As DB_WorkerData
+  Set AccessWorkerData = New DB_WorkerData
+  Call AccessWorkerData.Init(iSource)
+End Function
+
+Public Function AccessGlobalWorks() As DB_GlobalWorks
+  Static s_Data As DB_GlobalWorks
+  
+  If s_Data Is Nothing Then
+    Set s_Data = New DB_GlobalWorks
+    Call s_Data.Init(ThisWorkbook.Worksheets(SHEET_DATA), AccessProjects)
+  End If
+  
+  Set AccessGlobalWorks = s_Data
+End Function
+
+Public Function AccessProjects() As DB_CachedProjects
+  Static s_Projects As DB_CachedProjects
+  
+  If s_Projects Is Nothing Then
+    Dim xlApp As New API_XLWrapper: Call xlApp.CreateApplication(bIsVisible:=False)
+    Dim iSource As Excel.Workbook: Set iSource = xlApp.OpenDocument(PATH_PROJECTS, bReadOnly:=True)
+    If iSource Is Nothing Then
+      Call UserInteraction.ShowMessage(EM_CANNOT_ACCESS_PROJECTS, PATH_PROJECTS)
+      Exit Function
+    End If
+  
+    Set s_Projects = New DB_CachedProjects
+    Call s_Projects.Reload(iSource)
+    
+    Call xlApp.ReleaseDocument
+    Call xlApp.ReleaseApplication
+  End If
+  
+  Set AccessProjects = s_Projects
+End Function

src/aggregator/Declarations.bas

@@ -0,0 +1,29 @@
+Attribute VB_Name = "Declarations"
+Option Private Module
+Option Explicit
+
+Public Const FIRST_ROW = 2
+
+Public Const CELL_DATE_START = "c_DateStart"
+
+Public Const SHEET_WORKERS = "Ñîòðóäíèêè"
+Public Const SHEET_DATA = "Äàííûå"
+
+Public Enum WorkerStructure
+  S_E_ID = 1
+  S_E_NAME = 2
+  S_E_ACTIVE = 3
+  S_E_HOURS = 4
+  S_E_PATH = 5
+End Enum
+
+Public Enum GlobalDataStructure
+  S_GD_WORKER_ID = 1
+  S_GD_YEAR = 2
+  S_GD_DATE = 3
+  S_GD_CATEGORY = 4
+  S_GD_PROJECT = 5
+  S_GD_HOURS = 6
+  S_GD_WORK_TYPE = 7
+  S_GD_DESCRIPTION = 8
+End Enum

src/aggregator/DevHelper.bas

@@ -0,0 +1,21 @@
+Attribute VB_Name = "DevHelper"
+Option Private Module
+Option Explicit
+
+Public Function Dev_PrepareSkeleton()
+  Call ClearAll
+End Function
+
+Public Function Dev_ManualRunTest()
+  Dim sSuite$: sSuite = "s_UndoWrapper"
+  Dim sTest$: sTest = "t_BasicUndo"
+  Dim sMsg$: sMsg = Dev_RunTestDebug(sSuite, sTest)
+  Debug.Print sMsg
+  Call MsgBox(sMsg)
+End Function
+
+Public Function Dev_GetTestSuite(sName$) As Object
+  Select Case sName
+  '  Case "s_ParseDate": Set Dev_GetTestSuite = New s_ParseDate
+  End Select
+End Function

src/aggregator/ItemInputWorker.cls

@@ -0,0 +1,14 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ItemInputWorker"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public workerID_ As String
+Public workerName_ As String
+Public path_ As String

src/aggregator/IteratorGlobalWork.cls

@@ -0,0 +1,105 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "IteratorGlobalWork"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public row_ As Long
+Private data_ As Excel.Worksheet
+
+Public Sub Init(target As Excel.Worksheet, Optional tRow& = FIRST_ROW)
+  Set data_ = target
+  row_ = tRow
+End Sub
+
+Public Function Increment(Optional inc& = 1)
+  If row_ + inc > 0 Then _
+    row_ = row_ + inc
+End Function
+
+Public Function GoFirst()
+  row_ = FIRST_ROW
+End Function
+
+Public Function GoLast()
+  row_ = data_.Columns(S_GD_WORKER_ID).Find(vbNullString, LookAt:=xlWhole).Row - 1
+End Function
+
+Public Function IsDone() As Boolean
+  IsDone = data_.Cells(row_, S_GD_WORKER_ID) = vbNullString
+End Function
+
+Public Function RemoveRow()
+  Call data_.Rows(row_).Delete
+End Function
+
+'===== Propertiy Get =====
+Public Property Get WorkerID() As String
+  WorkerID = data_.Cells(row_, S_GD_WORKER_ID)
+End Property
+
+Public Property Get Year() As Integer
+  Year = data_.Cells(row_, S_GD_YEAR)
+End Property
+
+Public Property Get DDate() As Long
+  DDate = data_.Cells(row_, S_GD_DATE)
+End Property
+
+Public Property Get Category() As TProjectCategory
+  Category = CCStringToCategory(data_.Cells(row_, S_GD_CATEGORY))
+End Property
+
+Public Property Get Project() As String
+  Project = data_.Cells(row_, S_GD_PROJECT)
+End Property
+
+Public Property Get Duration() As Double
+  Duration = data_.Cells(row_, S_GD_HOURS)
+End Property
+
+Public Property Get WorkType() As String
+  WorkType = data_.Cells(row_, S_GD_WORK_TYPE)
+End Property
+
+Public Property Get Description() As String
+  Description = data_.Cells(row_, S_GD_DESCRIPTION)
+End Property
+
+' ==== Property Let ====
+Public Property Let WorkerID(newVal$)
+  data_.Cells(row_, S_GD_WORKER_ID) = newVal
+End Property
+
+Public Property Let Year(newVal%)
+  data_.Cells(row_, S_GD_YEAR) = newVal
+End Property
+
+Public Property Let DDate(newVal&)
+  data_.Cells(row_, S_GD_DATE) = newVal
+End Property
+
+Public Property Let Category(newVal As TProjectCategory)
+  data_.Cells(row_, S_GD_CATEGORY) = CCCategoryToString(newVal)
+End Property
+
+Public Property Let Project(newVal$)
+  data_.Cells(row_, S_GD_PROJECT) = newVal
+End Property
+
+Public Property Let Duration(newVal As Double)
+  data_.Cells(row_, S_GD_HOURS) = newVal
+End Property
+
+Public Property Let WorkType(newVal$)
+  data_.Cells(row_, S_GD_WORK_TYPE) = newVal
+End Property
+
+Public Property Let Description(newVal$)
+  data_.Cells(row_, S_GD_DESCRIPTION) = newVal
+End Property

src/aggregator/IteratorWorker.cls

@@ -0,0 +1,81 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "IteratorWorker"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public row_ As Long
+Private data_ As Excel.Worksheet
+
+Public Sub Init(target As Excel.Worksheet, Optional tRow& = FIRST_ROW)
+  Set data_ = target
+  row_ = tRow
+End Sub
+
+Public Function Increment(Optional inc& = 1)
+  If row_ + inc > 0 Then _
+    row_ = row_ + inc
+End Function
+
+Public Function GoFirst()
+  row_ = FIRST_ROW
+End Function
+
+Public Function GoLast()
+  row_ = data_.Columns(S_E_ID).Find(vbNullString, LookAt:=xlWhole).Row - 1
+End Function
+
+Public Function IsDone() As Boolean
+  IsDone = data_.Cells(row_, S_E_ID) = vbNullString
+End Function
+
+Public Function RemoveRow()
+  Call data_.Rows(row_).Delete
+End Function
+
+'===== Propertiy Get =====
+Public Property Get WorkerID() As String
+  WorkerID = data_.Cells(row_, S_E_ID)
+End Property
+
+Public Property Get WorkerName() As String
+  WorkerName = data_.Cells(row_, S_E_NAME)
+End Property
+
+Public Property Get Active() As Boolean
+  Active = data_.Cells(row_, S_E_ACTIVE) = 1
+End Property
+
+Public Property Get Hours() As Double
+  Hours = data_.Cells(row_, S_E_HOURS)
+End Property
+
+Public Property Get ReportPath() As String
+  ReportPath = data_.Cells(row_, S_E_PATH)
+End Property
+
+' ==== Property Let ====
+Public Property Let WorkerID(newVal$)
+  data_.Cells(row_, S_E_ID) = newVal
+End Property
+
+Public Property Let WorkerName(newVal$)
+  data_.Cells(row_, S_E_NAME) = newVal
+End Property
+
+Public Property Let Active(newVal As Boolean)
+  data_.Cells(row_, S_E_ACTIVE) = IIf(newVal, 1, 0)
+End Property
+
+Public Property Let Hours(newVal As Double)
+  data_.Cells(row_, S_E_HOURS) = newVal
+End Property
+
+Public Property Let ReportPath(newVal$)
+  data_.Cells(row_, S_E_PATH) = newVal
+End Property

src/aggregator/Main.bas

@@ -0,0 +1,86 @@
+Attribute VB_Name = "Main"
+Option Explicit
+Option Private Module
+
+Public Sub RunAddWorker()
+  Dim iWorkers As DB_Workers: Set iWorkers = AccessWorkers
+  Dim iInput As ItemInputWorker: Set iInput = PromptInputWorker(iWorkers)
+  If iInput Is Nothing Then _
+    Exit Sub
+  
+  Call iWorkers.AddWroker(iInput.workerID_, iInput.workerName_, iInput.path_)
+  Call ThisWorkbook.Sheets(SHEET_WORKERS).Activate
+  Call UserInteraction.ShowMessage(IM_ADD_WORKER_OK, iInput.workerName_)
+End Sub
+
+Public Sub RunReloadWorker()
+  Dim iWorkers As DB_Workers: Set iWorkers = AccessWorkers
+  Dim sInputID$: sInputID = PromptWorkerID(iWorkers)
+  If sInputID = vbNullString Then _
+    Exit Sub
+  
+  Dim xlApp As New API_XLWrapper: Call xlApp.SetApplication(ThisWorkbook.Application)
+  Call xlApp.PauseUI
+  Dim bLoaded As Boolean: bLoaded = ReloadWorker(iWorkers.Access(sInputID), AccessGlobalWorks, GetStartDate)
+  Call xlApp.ResumeUI
+  
+  If bLoaded Then _
+    Call UserInteraction.ShowMessage(IM_RELOAD_WORKER_OK)
+End Sub
+
+Public Sub RunRemoveWorker()
+  Dim iWorkers As DB_Workers: Set iWorkers = AccessWorkers
+  Dim sInputID$: sInputID = PromptWorkerID(iWorkers)
+  If sInputID = vbNullString Then _
+    Exit Sub
+  
+  Dim iWorker As IteratorWorker: Set iWorker = iWorkers.Access(sInputID)
+  If Not iWorker.Active Then
+    Call UserInteraction.ShowMessage(EM_WORKER_ALREADY_REMOVED, iWorker.WorkerName)
+  Else
+    iWorker.Active = False
+    Call ThisWorkbook.Sheets(SHEET_WORKERS).Activate
+    Call UserInteraction.ShowMessage(IM_REMOVE_WORKER_OK, iWorker.WorkerName)
+  End If
+End Sub
+
+Public Sub RunReloadAll()
+  Dim iWorkers As DB_Workers: Set iWorkers = AccessWorkers
+  Dim nStartDate&: nStartDate = GetStartDate
+  Dim iGlobalWorks As DB_GlobalWorks: Set iGlobalWorks = AccessGlobalWorks
+  
+  Call CSE_ProgressBar.Init("Îáíîâëåíèå äàííûõ", maxVal:=iWorkers.CountActive)
+  Call CSE_ProgressBar.ShowModeless
+  
+  Dim xlApp As New API_XLWrapper: Call xlApp.SetApplication(ThisWorkbook.Application)
+  Call xlApp.PauseUI
+  
+  Dim iWorker As IteratorWorker: Set iWorker = iWorkers.IBegin
+  Do While Not iWorker.IsDone
+    If iWorker.Active Then
+      CSE_ProgressBar.Description = iWorker.WorkerName
+      Call ReloadWorker(iWorker, iGlobalWorks, nStartDate)
+      Call CSE_ProgressBar.IncrementA
+    End If
+    Call iWorker.Increment
+  Loop
+  
+  Call UpdatePivots
+  Call xlApp.ResumeUI
+  
+  Call Unload(CSE_ProgressBar)
+  Call UserInteraction.ShowMessage(IM_RELOAD_ALL_OK)
+End Sub
+
+Public Sub RunInfoProjects()
+  Dim xlApp As New API_XLWrapper: Call xlApp.SetApplication(ThisWorkbook.Application)
+  Dim iProjects As Excel.Workbook: Set iProjects = xlApp.OpenDocument(PATH_PROJECTS, bReadOnly:=True)
+  If iProjects Is Nothing Then
+    Call UserInteraction.ShowMessage(EM_CANNOT_ACCESS_PROJECTS, PATH_PROJECTS)
+    Exit Sub
+  End If
+End Sub
+
+Public Sub RunInfoCalendar()
+  Call UserInteraction.FollowHyperlink(ActiveWorkbook, URL_CALENDAR_CONSULTANT & "/" & VBA.Year(VBA.Int(VBA.Now)))
+End Sub

src/aggregator/MainImpl.bas

@@ -0,0 +1,70 @@
+Attribute VB_Name = "MainImpl"
+Option Private Module
+Option Explicit
+
+Public Function ClearAll()
+  Call ThisWorkbook.Worksheets(SHEET_DATA).UsedRange.Offset(1).ClearContents
+  Call ThisWorkbook.Worksheets(SHEET_WORKERS).UsedRange.Offset(1).ClearContents
+  Call UpdatePivots
+End Function
+
+Public Function UpdatePivots()
+  Dim iPivot As Excel.PivotTable
+  Dim iSheet As Excel.Worksheet
+  For Each iSheet In ThisWorkbook.Sheets
+    For Each iPivot In iSheet.PivotTables
+      On Error Resume Next
+      With iPivot
+        .RefreshTable
+        .Update
+      End With
+      On Error GoTo 0
+    Next iPivot
+  Next iSheet
+End Function
+
+Public Function PromptInputWorker(iWorkers As DB_Workers) As ItemInputWorker
+  With CreateWorkerDlg
+    Call .Init(iWorkers)
+    Call .Show
+    If .isCanceled_ Then _
+      Exit Function
+    Set PromptInputWorker = .GetUserInput
+  End With
+End Function
+
+Public Function PromptWorkerID(iWorkers As DB_Workers) As String
+  Dim sInput$: sInput = UserInteraction.PromptInput("Ââåäåèòå èíèöèàëû", "Âûáîð ñîòðóäíèêà")
+  If sInput = vbNullString Then _
+    Exit Function
+  If iWorkers.Contains(sInput) Then
+    PromptWorkerID = sInput
+  Else
+    Call UserInteraction.ShowMessage(EM_INVALID_WORKER, sInput)
+  End If
+End Function
+
+Public Function ReloadWorker(iWorker As IteratorWorker, iData As DB_GlobalWorks, nStartDate&) As Boolean
+  ReloadWorker = False
+  
+  Dim sPath$: sPath = iWorker.ReportPath
+  Dim fso As New Scripting.FileSystemObject
+  If Not fso.FileExists(sPath) Then
+    Call UserInteraction.ShowMessage(EM_MISSING_REPORT_FILE, sPath)
+    Exit Function
+  End If
+  
+  Dim xlApp As New API_XLWrapper: Call xlApp.SetApplication(ThisWorkbook.Application)
+  Dim iReport As Excel.Workbook: Set iReport = xlApp.OpenDocument(sPath, bReadOnly:=True)
+  If iReport Is Nothing Then _
+    Exit Function
+    
+  ReloadWorker = ValidateReport(iReport)
+  If ReloadWorker Then
+    Call iData.ReloadDataFor(iWorker, iReport, nStartDate)
+  Else
+    Call UserInteraction.ShowMessage(EM_REPORT_INVALID, sPath)
+  End If
+  Call xlApp.ReleaseDocument
+End Function
+

src/aggregator/z_UIMessages.bas

@@ -0,0 +1,70 @@
+Attribute VB_Name = "z_UIMessages"
+' Messaging module
+Option Private Module
+Option Explicit
+
+Public Enum MsgCode
+  MSG_OK = 0
+  
+  EM_INVALID_WORKER
+  EM_WORKER_ALREADY_EXISTS
+  EM_WORKER_ALREADY_REMOVED
+  EM_CANNOT_ACCESS_PROJECTS
+  EM_MISSING_REPORT_FILE
+  EM_REPORT_INVALID
+
+  IM_ADD_WORKER_OK
+  IM_REMOVE_WORKER_OK
+  IM_RELOAD_WORKER_OK
+  IM_RELOAD_ALL_OK
+
+ ' QM_CODE_DELETE_CONFIRM
+End Enum
+
+Private g_UI As API_UserInteraction
+
+Public Function UserInteraction() As API_UserInteraction
+  If g_UI Is Nothing Then _
+    Set g_UI = New API_UserInteraction
+  Set UserInteraction = g_UI
+End Function
+
+Public Function SetUserInteraction(newUI As API_UserInteraction)
+  Set g_UI = newUI
+End Function
+
+Public Function UIShowMessage(theCode As MsgCode, ParamArray params() As Variant)
+  Dim unwrapped As Variant: unwrapped = params
+  unwrapped = FixForwardedParams(unwrapped)
+  
+  Select Case theCode
+  Case EM_INVALID_WORKER:             Call MsgBox(Fmt("Ñîòðóäíèê îòñóòñòâóåò â áàçå: {1}", unwrapped), vbExclamation)
+  Case EM_WORKER_ALREADY_EXISTS:      Call MsgBox(Fmt("Èíèöèàëû ñîòðóäíèêà óæå çàíÿòû: {1}", unwrapped), vbExclamation)
+  Case EM_WORKER_ALREADY_REMOVED:     Call MsgBox(Fmt("Ñîòðóäíèê óæå íå àêòèâåí: {1}", unwrapped), vbExclamation)
+  Case EM_CANNOT_ACCESS_PROJECTS:     Call MsgBox(Fmt("Íå óäàëîñü ïîëó÷èòü äîñòóï ê ñïèñêó ïðîåêòîâ" & vbNewLine & "{1}", unwrapped), vbExclamation)
+  Case EM_MISSING_REPORT_FILE:        Call MsgBox(Fmt("Íå óäàëîñü íàéòè ôàéë ñîòðóäíèêà: {1}", unwrapped), vbExclamation)
+  Case EM_REPORT_INVALID:             Call MsgBox(Fmt("Ôàéë îò÷åòà íå ñîîòâåòñòâóåò ôîðìàòó: {1}", unwrapped), vbExclamation)
+      
+  Case IM_ADD_WORKER_OK:              Call MsgBox(Fmt("Ñîòðóäíèê óñïåøíî äîáàâëåí: {1}", unwrapped), vbInformation)
+  Case IM_REMOVE_WORKER_OK:           Call MsgBox(Fmt("Ñòàòóñ èçìåíåí: {1}", unwrapped), vbInformation)
+  Case IM_RELOAD_WORKER_OK:           Call MsgBox("Äàííûå ñîòðóäíèêà çàãðóæåíû óñïåøíî", vbInformation)
+  Case IM_RELOAD_ALL_OK:             Call MsgBox("Äàííûå àêòèâíûõ ñîòðóäíèêîâ îáíîâëåíû", vbInformation)
+      
+  Case Else:                          Call MsgBox("Invalid message code", vbCritical)
+  End Select
+End Function
+
+Public Function UIAskQuestion(theCode As MsgCode, ParamArray params() As Variant) As Boolean
+  Dim unwrapped As Variant: unwrapped = params
+  unwrapped = FixForwardedParams(unwrapped)
+  
+  Dim answer&: answer = vbNo
+  Select Case theCode
+ ' Case QM_CODE_DELETE_CONFIRM
+ '   answer = MsgBox("Are you sure you want to delete ALL macros from target file?", vbYesNo + vbQuestion)
+    
+  Case Else
+    Call MsgBox("Invalid message code", vbCritical)
+  End Select
+  UIAskQuestion = answer = vbYes
+End Function

src/aggregator/z_UIRibbon.bas

@@ -0,0 +1,16 @@
+Attribute VB_Name = "z_UIRibbon"
+Option Private Module
+Option Explicit
+
+Public Sub OnRibbonBtn(iControl As IRibbonControl)
+  Select Case iControl.ID
+    Case "AddWorker":           Call RunAddWorker
+    Case "RemoveWorker":        Call RunRemoveWorker
+    Case "ReloadWorker":        Call RunReloadWorker
+    
+    Case "ReloadAll":           Call RunReloadAll
+  
+    Case "InfoProjects":        Call RunInfoProjects
+    Case "InfoCalendar":        Call RunInfoCalendar
+  End Select
+End Sub

src/common/DB_CachedProjects.cls

@@ -0,0 +1,105 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "DB_CachedProjects"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public projects_ As Scripting.Dictionary
+Private substitutes_ As Scripting.Dictionary
+
+Public Function Reload(iSource As Excel.Workbook)
+  Set projects_ = New Scripting.Dictionary
+  Set substitutes_ = New Scripting.Dictionary
+  Call ScanSubsitutes(iSource)
+  Call ScanActiveProjects(iSource)
+  Call ScanArchiveProjects(iSource)
+End Function
+
+Public Function GetProjectCategory(sProject$) As TProjectCategory
+  Dim sFixedProject$: sFixedProject = ApplySustitutions(sProject)
+  If Not projects_.Exists(sFixedProject) Then
+    GetProjectCategory = T_PCAT_ERR
+  Else
+    GetProjectCategory = projects_(sFixedProject).category_
+  End If
+End Function
+
+Public Function GetProjectManager(sProject$) As String
+  Dim sFixedProject$: sFixedProject = ApplySustitutions(sProject)
+  If Not projects_.Exists(sFixedProject) Then
+    Exit Function
+  Else
+    GetProjectManager = projects_(sFixedProject).manager_
+  End If
+End Function
+
+' =======
+Private Function ApplySustitutions(sProject$) As String
+  If substitutes_.Exists(sProject) Then
+    ApplySustitutions = substitutes_(sProject)
+  Else
+    ApplySustitutions = sProject
+  End If
+End Function
+
+Private Function ScanActiveProjects(iSource As Excel.Workbook)
+  Dim iData() As String: iData = LoadActiveProjects(iSource)
+  If ArraySize(iData, 1) < 1 Then _
+    Exit Function
+  Dim nItem&
+  Dim iProject As ItemCachedProject
+  For nItem = LBound(iData, 1) To UBound(iData, 1) Step 1
+    Set iProject = New ItemCachedProject
+    Dim sProject$: sProject = iData(nItem, S_TP_NAME)
+    With iProject
+      .isActive_ = True
+      .category_ = iData(nItem, S_TP_TYPE)
+      .name_ = sProject
+      .manager_ = iData(nItem, S_TP_MANAGER)
+    End With
+    If Not projects_.Exists(sProject) Then
+      Call projects_.Add(sProject, iProject.Clone())
+    Else
+      Debug.Print sProject
+    End If
+    
+  Next nItem
+End Function
+
+Private Function ScanArchiveProjects(iSource As Excel.Workbook)
+  Dim iData() As String: iData = LoadArchiveProjects(iSource)
+  If ArraySize(iData, 1) < 1 Then _
+    Exit Function
+  Dim nItem&
+  Dim iProject As ItemCachedProject
+  For nItem = LBound(iData, 1) To UBound(iData, 1) Step 1
+    Set iProject = New ItemCachedProject
+    Dim sProject$: sProject = iData(nItem, S_TP_NAME)
+    With iProject
+      .isActive_ = False
+      .category_ = iData(nItem, S_TP_TYPE)
+      .name_ = sProject
+      .manager_ = iData(nItem, S_TP_MANAGER)
+    End With
+    If Not projects_.Exists(sProject) Then
+      Call projects_.Add(sProject, iProject.Clone())
+    Else
+      Debug.Print sProject
+    End If
+  Next nItem
+End Function
+
+Private Function ScanSubsitutes(iSource As Excel.Workbook)
+  Dim iData() As String: iData = LoadProjectSubstitutes(iSource)
+  If ArraySize(iData, 1) < 1 Then _
+    Exit Function
+  Dim nItem&
+  For nItem = LBound(iData, 1) To UBound(iData, 1) Step 1
+    Call substitutes_.Add(iData(nItem, S_TS_MATCH_TARGET), iData(nItem, S_TS_REPLACEMENT))
+  Next nItem
+End Function

src/common/DB_Projects.cls

@@ -0,0 +1,69 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "DB_Projects"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private data_ As Excel.Worksheet
+
+Public Function Init(iData As Excel.Worksheet)
+  Set data_ = iData
+End Function
+
+Public Property Get Data() As Excel.Worksheet
+  Set Data = data_
+End Property
+
+Public Property Get Count() As Long
+  Count = ILast.row_ - IBegin.row_ + 1
+End Property
+
+Public Function IBegin() As IteratorProject
+  Set IBegin = New IteratorProject
+  Call IBegin.Init(data_)
+End Function
+
+Public Function ILast() As IteratorProject
+  Set ILast = New IteratorProject
+  Call ILast.Init(data_)
+  Call ILast.GoLast
+End Function
+
+Public Function INew() As IteratorProject
+  Set INew = New IteratorProject
+  Call INew.Init(data_)
+  Call INew.GoLast
+  Call INew.Increment
+End Function
+
+Public Function UpdateSorting()
+  Call data_.Columns("A:E").Sort(Key1:=data_.Cells(1, S_P_PERMANENT), Order1:=xlDescending, _
+                            Key2:=data_.Cells(1, S_P_TYPE), Order2:=xlDescending, _
+                            Key3:=data_.Cells(1, S_P_NAME), Order3:=xlDescending)
+End Function
+
+Public Function DumpData() As String()
+  Dim nCount&: nCount = Count
+  If nCount = 0 Then _
+    Exit Function
+
+  Dim iDump() As String
+  ReDim iDump(1 To nCount, ProjectTransferStruct.[_First] To ProjectTransferStruct.[_Last])
+  Dim iter As IteratorProject: Set iter = IBegin
+  Dim nItem&: nItem = 1
+  Do While Not iter.IsDone
+    iDump(nItem, S_TP_TYPE) = iter.PCategory
+    iDump(nItem, S_TP_NAME) = iter.Project
+    iDump(nItem, S_TP_MANAGER) = iter.Manager
+    Call iter.Increment
+    nItem = nItem + 1
+  Loop
+
+  DumpData = iDump
+End Function
+

src/common/DB_WorkerData.cls

@@ -0,0 +1,109 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "DB_WorkerData"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private source_ As Excel.Workbook
+Private data_ As Excel.Worksheet
+
+Public Function Init(iSource As Excel.Workbook)
+  Set source_ = iSource
+  Set data_ = source_.Sheets(WORKER_SHEET_DATA)
+End Function
+
+Public Property Get WorkerID() As String
+  WorkerID = source_.Names(CELL_WORKER_ID).RefersToRange
+End Property
+
+Public Property Get WorkerName() As String
+  WorkerName = source_.Names(CELL_WORKER_NAME).RefersToRange
+End Property
+
+Public Function IBegin() As IteratorWork
+  Set IBegin = New IteratorWork
+  Call IBegin.Init(data_)
+End Function
+
+Public Function ILast() As IteratorWork
+  Set ILast = New IteratorWork
+  Call ILast.Init(data_)
+  Call ILast.GoLast
+End Function
+
+Public Function INew() As IteratorWork
+  Set INew = New IteratorWork
+  Call INew.Init(data_)
+  Call INew.GoLast
+  Call INew.Increment
+End Function
+
+' ====== Actions =======
+Public Function FixDataGroups()
+  On Error Resume Next
+  Call data_.UsedRange.Rows.Ungroup
+  Call data_.UsedRange.Rows.ClearOutline
+  On Error GoTo 0
+
+  Dim nRow&: nRow = WORKER_FIRST_ROW
+  Dim nLevel&
+  Do
+    Dim sText$: sText = data_.Cells(nRow, S_W_DATE)
+    If sText = vbNullString Then _
+      Exit Function
+    If sText Like "ÃÎÄ:*" Then
+      nLevel = 1
+    ElseIf sText Like "Ìåñÿö:*" Then
+      nLevel = 2
+    Else
+      nLevel = 3
+    End If
+    data_.Rows(nRow).OutlineLevel = nLevel
+
+    nRow = nRow + 1
+  Loop
+End Function
+
+Public Function DeleteHolidays() As Long
+  Dim iWork As IteratorWork: Set iWork = IBegin
+  Do While Not iWork.IsDone
+    If iWork.Project = PROJECT_HOLIDAYS Then
+      Call iWork.RemoveRow
+      DeleteHolidays = DeleteHolidays + 1
+    Else
+      Call iWork.Increment
+    End If
+  Loop
+End Function
+
+Public Function CreateYear(nYear%)
+  Dim iOut As IteratorWork: Set iOut = INew
+  Dim nDate&: nDate = VBA.DateSerial(nYear, 1, 1)
+  Call iOut.AddYear(nYear)
+  Do While VBA.Year(nDate) = nYear
+    If VBA.Day(nDate) = 1 Then _
+      Call iOut.AddMonth(VBA.Month(nDate))
+    Call iOut.AddDay(nDate, VBA.Weekday(nDate, vbMonday) > 5)
+    nDate = nDate + 1
+  Loop
+End Function
+
+Public Function ImportYear(iSource As Excel.Worksheet)
+  Dim iOut As IteratorWork: Set iOut = INew
+  Dim nRow&: nRow = 1
+  Dim nDate&: nDate = iSource.Cells(nRow, 1)
+  Dim nYear%: nYear = VBA.Year(nDate)
+  Call iOut.AddYear(nYear)
+  Do While VBA.Year(nDate) = nYear
+    If VBA.Day(nDate) = 1 Then _
+      Call iOut.AddMonth(VBA.Month(nDate))
+    Call iOut.AddDay(nDate, iSource.Cells(nRow, 2) = PROJECT_HOLIDAYS)
+    nRow = nRow + 1
+    nDate = iSource.Cells(nRow, 1)
+  Loop
+End Function

src/common/DataTransfer.bas

@@ -0,0 +1,48 @@
+Attribute VB_Name = "DataTransfer"
+Option Private Module
+Option Explicit
+
+Public Const PATH_PROJECTS = "\\fs1.concept.ru\Exchange\!Ñïèñîê ïðîåêòîâ.xlsm"
+
+'# _TP_ Ñòðóêòóðà ïåðåäàâàåìûõ äàííûõ î ïðîåêòàõ
+Public Enum ProjectTransferStruct
+  [_First] = 1
+  
+  S_TP_TYPE = 1
+  S_TP_NAME = 2
+  S_TP_MANAGER = 3
+
+  [_Last] = 3
+End Enum
+
+'# _TS_ Ñòðóêòóðà ïåðåäàâàåìûõ äàííûõ î ïîäñòàíîâêàõ
+Public Enum SubsTransferStruct
+  [_First] = 1
+  
+  S_TS_MATCH_TARGET = 1
+  S_TS_REPLACEMENT = 2
+
+  [_Last] = 2
+End Enum
+
+Public Function LoadActiveProjects(iProjectWB As Excel.Workbook) As String()
+  Dim iDump() As String: iDump = iProjectWB.Application.Run("'" & iProjectWB.Name & "'" & "!GetActiveDump")
+  If Not IsArrayAllocated(iDump) Then _
+    Exit Function
+  LoadActiveProjects = iDump
+End Function
+
+Public Function LoadArchiveProjects(iProjectWB As Excel.Workbook) As String()
+  Dim iDump() As String: iDump = iProjectWB.Application.Run("'" & iProjectWB.Name & "'" & "!GetArchiveDump")
+  If Not IsArrayAllocated(iDump) Then _
+    Exit Function
+  LoadArchiveProjects = iDump
+End Function
+
+Public Function LoadProjectSubstitutes(iProjectWB As Excel.Workbook) As String()
+  Dim iDump() As String: iDump = iProjectWB.Application.Run("'" & iProjectWB.Name & "'" & "!GetSubstitutesDump")
+  If Not IsArrayAllocated(iDump) Then _
+    Exit Function
+  LoadProjectSubstitutes = iDump
+End Function
+

src/common/DeclarationsWorker.bas

@@ -0,0 +1,44 @@
+Attribute VB_Name = "DeclarationsWorker"
+Option Explicit
+Option Private Module
+
+Public Const WORKER_FIRST_ROW = 2
+
+Public Const WORKER_SHEET_DATA = "Ó÷åò"
+
+Public Const CELL_WORKER_ID = "c_WorkerID"
+Public Const CELL_WORKER_NAME = "c_WorkerName"
+Public Const CELL_WORKER_INDICATOR = "c_ConceptReport"
+
+Public Const PATH_CALENDAR = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\02 Îôèñíàÿ àâòîìàòèçàöèÿ\01 Âñåó÷åò\Ïðîèçâîäñòâåííûé êàëåíäàðü.xlsx"
+Public Const PATH_MONTHLY_TEMPLATE = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\04 Ñòàíäàðò îôîðìëåíèÿ\01 Îáùèå øàáëîíû\90 Åæåìåñÿ÷íûé îò÷åò.xltx"
+Public Const PATH_SAMPLES = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\02 Îôèñíàÿ àâòîìàòèçàöèÿ\01 Âñåó÷åò\Ïðèìåðû ðàáîò.xlsx"
+
+Public Const URL_CALENDAR_CONSULTANT = "http://www.consultant.ru/law/ref/calendar/proizvodstvennye"
+
+Public Const PROJECT_MISSING = "Îòñóòñòâèÿ"
+Public Const PROJECT_HOLIDAYS = "Ïðàçäíèêè/Âûõîäíûå"
+Public Const WORK_DEFAULT = "ÍÅÒ"
+
+Public Enum WorkStructure
+  [_First] = 1
+  
+  S_W_DATE = 1
+  S_W_PROJECT = 2
+  S_W_HOURS = 3
+  S_W_TYPE = 4
+  S_W_CONTENTS = 5
+  
+  [_Last] = 5
+End Enum
+
+Public Function ValidateReport(target As Excel.Workbook) As Boolean
+  On Error GoTo GO_FALSE
+  Dim rTest As Variant: rTest = target.Names(CELL_WORKER_INDICATOR).RefersTo
+  
+  ValidateReport = True
+  Exit Function
+
+GO_FALSE:
+  ValidateReport = False
+End Function

src/common/ItemCachedProject.cls

@@ -0,0 +1,32 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ItemCachedProject"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public category_ As TProjectCategory
+Public name_ As String
+Public manager_ As String
+Public isActive_ As Boolean
+
+Public Function Init(iCat As TProjectCategory, sProject$, sManager$, bIsActive As Boolean)
+  category_ = iCat
+  name_ = sProject
+  manager_ = sManager
+  isActive_ = bIsActive
+End Function
+  
+Public Function Clone() As ItemCachedProject
+  Set Clone = New ItemCachedProject
+  With Clone
+    .category_ = category_
+    .name_ = name_
+    .manager_ = manager_
+    .isActive_ = isActive_
+  End With
+End Function

src/common/IteratorProject.cls

@@ -0,0 +1,86 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "IteratorProject"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public row_ As Long
+Private data_ As Excel.Worksheet
+
+Public Sub Init(target As Excel.Worksheet, Optional nRow& = FIRST_ROW)
+  Set data_ = target
+  row_ = nRow
+End Sub
+
+Public Function Increment(Optional inc& = 1)
+  If row_ + inc > 0 Then _
+    row_ = row_ + inc
+End Function
+
+Public Function GoFirst()
+  row_ = FIRST_ROW
+End Function
+
+Public Function GoLast()
+  row_ = data_.Columns(S_P_NAME).Find(vbNullString, LookAt:=xlWhole).Row - 1
+End Function
+
+Public Function IsDone() As Boolean
+  IsDone = data_.Cells(row_, S_P_NAME) = vbNullString
+End Function
+
+Public Function RemoveRow()
+  Call data_.Rows(row_).Delete
+End Function
+
+Public Function ImportFrom(iAnother As IteratorProject)
+  PCategory = iAnother.PCategory
+  Project = iAnother.Project
+  Manager = iAnother.Manager
+  DateFinished = iAnother.DateFinished
+End Function
+
+'===== Propertiy Get =====
+Public Property Get PCategory() As TProjectCategory
+  PCategory = data_.Cells(row_, S_P_TYPE)
+End Property
+
+Public Property Get Project() As String
+  Project = data_.Cells(row_, S_P_NAME)
+End Property
+
+Public Property Get Manager() As String
+  Manager = data_.Cells(row_, S_P_MANAGER)
+End Property
+
+Public Property Get DateFinished() As Long
+  DateFinished = data_.Cells(row_, S_P_DATE)
+End Property
+
+Public Property Get IsPermanent() As Boolean
+  IsPermanent = data_.Cells(row_, S_P_PERMANENT) = 1
+End Property
+
+' ==== Property Let ====
+Public Property Let PCategory(newVal As TProjectCategory)
+  data_.Cells(row_, S_P_TYPE) = newVal
+End Property
+
+Public Property Let Project(newVal$)
+  data_.Cells(row_, S_P_NAME) = newVal
+End Property
+
+Public Property Let Manager(newVal$)
+  data_.Cells(row_, S_P_MANAGER) = newVal
+End Property
+
+Public Property Let DateFinished(newVal&)
+  If newVal > 0 Then _
+    data_.Cells(row_, S_P_DATE) = newVal
+End Property
+

src/common/IteratorWork.cls

@@ -0,0 +1,136 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "IteratorWork"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public row_ As Long
+Private data_ As Excel.Worksheet
+
+Public Sub Init(target As Excel.Worksheet, Optional tRow& = WORKER_FIRST_ROW)
+  Set data_ = target
+  row_ = tRow
+  Call SkipFillers
+End Sub
+
+Private Function SkipFillers()
+  Do
+    If data_.Cells(row_, S_W_DATE) = vbNullString Then _
+      Exit Function
+    If VBA.IsDate(data_.Cells(row_, S_W_DATE)) Then _
+      Exit Function
+    row_ = row_ + 1
+  Loop
+End Function
+
+Public Function Increment()
+  row_ = row_ + 1
+  Call SkipFillers
+End Function
+
+Public Function GoFirst()
+  row_ = WORKER_FIRST_ROW
+  Call SkipFillers
+End Function
+
+Public Function GoLast()
+  row_ = data_.Columns(S_W_DATE).Find(vbNullString, LookAt:=xlWhole).Row - 1
+End Function
+
+Public Function GoUntil(nTargetDate&)
+  Do While Not IsDone And DDate < nTargetDate
+    Call Increment
+  Loop
+End Function
+
+Public Function IsDone() As Boolean
+  IsDone = data_.Cells(row_, S_W_DATE) = vbNullString
+End Function
+
+Public Function IsMergedDescription() As Boolean
+  IsMergedDescription = False
+  Dim iDescription As Excel.Range: Set iDescription = data_.Cells(row_, S_W_CONTENTS)
+  If Not iDescription.MergeCells Then _
+    Exit Function
+  
+  IsMergedDescription = iDescription.MergeArea.Cells(1, 1).Row <> row_
+End Function
+
+Public Function RemoveRow()
+  Call data_.Rows(row_).Delete
+End Function
+
+Public Function AddYear(nYear%)
+  data_.Rows(row_).OutlineLevel = 1
+  data_.Cells(row_, S_W_DATE) = Fmt("ÃÎÄ: {1}", nYear)
+  Call Increment
+End Function
+
+Public Function AddMonth(nMonth%)
+  data_.Rows(row_).OutlineLevel = 2
+  data_.Cells(row_, S_W_DATE) = Fmt("Ìåñÿö: {1}", VBA.MonthName(nMonth))
+  Call Increment
+End Function
+
+Public Function AddDay(nDate&, bIsHoliday As Boolean)
+  data_.Rows(row_).OutlineLevel = 3
+  
+  DDate = nDate
+  WorkType = WORK_DEFAULT
+  Duration = 0
+  Project = IIf(bIsHoliday, PROJECT_HOLIDAYS, PROJECT_MISSING)
+  
+  Call Increment
+End Function
+
+'===== Propertiy Get =====
+Public Property Get DDate() As Long
+  DDate = data_.Cells(row_, S_W_DATE)
+End Property
+
+Public Property Get Project() As String
+  Project = data_.Cells(row_, S_W_PROJECT)
+End Property
+
+Public Property Get Duration() As Double
+  Duration = data_.Cells(row_, S_W_HOURS)
+End Property
+
+Public Property Get WorkType() As String
+  WorkType = data_.Cells(row_, S_W_TYPE)
+End Property
+
+Public Property Get Description() As String
+  If Not IsMergedDescription Then
+    Description = data_.Cells(row_, S_W_CONTENTS)
+  Else
+    Description = data_.Cells(row_, S_W_CONTENTS).MergeArea.Cells(1, 1)
+  End If
+End Property
+
+' ==== Property Let ====
+Public Property Let DDate(newVal&)
+  data_.Cells(row_, S_W_DATE) = newVal
+End Property
+
+Public Property Let Project(newVal$)
+  data_.Cells(row_, S_W_PROJECT) = newVal
+End Property
+
+Public Property Let Duration(newVal As Double)
+  data_.Cells(row_, S_W_HOURS) = newVal
+End Property
+
+Public Property Let WorkType(newVal$)
+  data_.Cells(row_, S_W_TYPE) = newVal
+End Property
+
+Public Property Let Description(newVal$)
+  data_.Cells(row_, S_W_CONTENTS) = newVal
+End Property
+

src/projects/DataAccess.bas

@@ -0,0 +1,42 @@
+Attribute VB_Name = "DataAccess"
+Option Private Module
+Option Explicit
+
+Public Function AccessActive() As DB_Projects
+  Static s_Projects As DB_Projects
+  
+  If s_Projects Is Nothing Then
+    Set s_Projects = New DB_Projects
+    Call s_Projects.Init(ThisWorkbook.Worksheets(SHEET_ACTIVE))
+  End If
+  
+  Set AccessActive = s_Projects
+End Function
+
+Public Function AccessArchive() As DB_Projects
+  Static s_Projects As DB_Projects
+  
+  If s_Projects Is Nothing Then
+    Set s_Projects = New DB_Projects
+    Call s_Projects.Init(ThisWorkbook.Worksheets(SHEET_ARCHIVE))
+  End If
+  
+  Set AccessArchive = s_Projects
+End Function
+
+Public Function AccessSubstitutes() As Scripting.Dictionary
+  Dim iSubs As New Scripting.Dictionary
+  Dim iData As Excel.Worksheet: Set iData = ThisWorkbook.Sheets(SHEET_SUBSTITUTES)
+  Dim nRow&: nRow = FIRST_ROW
+  Do
+    Dim sTarget$: sTarget = iData.Cells(nRow, S_SUB_TARGET)
+    If sTarget = vbNullString Then _
+      Exit Do
+    Dim sReplacement$: sReplacement = iData.Cells(nRow, S_SUB_REPLACE)
+    
+    If Not iSubs.Exists(sTarget) Then _
+      Call iSubs.Add(sTarget, sReplacement)
+    nRow = nRow + 1
+  Loop
+  Set AccessSubstitutes = iSubs
+End Function

src/projects/Declarations.bas

@@ -0,0 +1,30 @@
+Attribute VB_Name = "Declarations"
+Option Private Module
+Option Explicit
+
+Public Const FIRST_ROW = 2
+
+Public Const SHEET_SUBSTITUTES = "Ïîäñòàíîâêè"
+Public Const SHEET_ACTIVE = "Àêòèâíûå"
+Public Const SHEET_ARCHIVE = "Àðõèâ"
+
+Public Enum ProjectStruct
+  [_First] = 1
+  
+  S_P_TYPE = 1
+  S_P_NAME = 2
+  S_P_MANAGER = 3
+  S_P_DATE = 4
+  S_P_PERMANENT = 5
+  
+  [_Last] = 5
+End Enum
+
+Public Enum SubstitutesStruct
+  [_First] = 1
+  
+  S_SUB_TARGET = 1
+  S_SUB_REPLACE = 2
+  
+  [_Last] = 2
+End Enum

src/projects/Main.bas

@@ -0,0 +1,45 @@
+Attribute VB_Name = "Main"
+Option Private Module
+Option Explicit
+
+Public Sub RunUpdate()
+  Dim iProjects As Scripting.Dictionary: Set iProjects = ScanProjects
+  Dim iActive As DB_Projects: Set iActive = AccessActive
+  Dim iArchive As DB_Projects: Set iArchive = AccessArchive
+  
+  Call UpdateProjects(iActive, iArchive, iProjects)
+  
+  Call MsgBox("Update complete", vbInformation)
+End Sub
+
+Public Sub RunSort()
+  Call AccessActive.UpdateSorting
+  Call AccessArchive.UpdateSorting
+End Sub
+
+Public Function GetActiveDump() As String()
+  GetActiveDump = AccessActive.DumpData
+End Function
+
+Public Function GetArchiveDump() As String()
+  GetArchiveDump = AccessArchive.DumpData
+End Function
+
+Public Function GetSubstitutesDump() As String()
+  Dim iSubs As Scripting.Dictionary: Set iSubs = AccessSubstitutes
+  If iSubs.Count = 0 Then _
+    Exit Function
+    
+  Dim iDump() As String
+  ReDim iDump(1 To iSubs.Count, SubsTransferStruct.[_First] To SubsTransferStruct.[_Last])
+  Dim nItem&: nItem = 1
+  Dim aKey As Variant
+  For Each aKey In iSubs
+    iDump(nItem, S_TS_MATCH_TARGET) = CStr(aKey)
+    iDump(nItem, S_TS_REPLACEMENT) = iSubs(aKey)
+    nItem = nItem + 1
+  Next aKey
+  GetSubstitutesDump = iDump
+End Function
+
+

src/projects/MainImpl.bas

@@ -0,0 +1,48 @@
+Attribute VB_Name = "MainImpl"
+Option Private Module
+Option Explicit
+
+Public Function ScanProjects() As Scripting.Dictionary
+  Dim iProjects As Scripting.Dictionary
+  Set iProjects = CCListProjects(T_PRJ_INCOME)
+  Call DictionaryAbsorbShallow(iProjects, CCListProjects(T_PRJ_OUTCOME))
+  Call DictionaryAbsorbShallow(iProjects, CCListProjects(T_PRJ_LEAD_ACTIVE))
+  Call DictionaryAbsorbShallow(iProjects, CCListProjects(T_PRJ_LEAD_TENTATIVE))
+  Set ScanProjects = iProjects
+End Function
+
+Public Function UpdateProjects(iActive As DB_Projects, iArchive As DB_Projects, iProjects As Scripting.Dictionary)
+  Call UpdateArchive(iActive, iArchive, iProjects)
+  Call AddNewActive(iActive, iProjects)
+  Call iActive.UpdateSorting
+  Call iArchive.UpdateSorting
+End Function
+
+' =====
+Private Function UpdateArchive(iActive As DB_Projects, iArchive As DB_Projects, iProjects As Scripting.Dictionary)
+  Dim iOut As IteratorProject: Set iOut = iArchive.INew
+  Dim iProj As IteratorProject: Set iProj = iActive.IBegin
+  Do While Not iProj.IsDone
+    If iProj.IsPermanent Then
+      Call iProj.Increment
+    ElseIf iProjects.Exists(iProj.Project) Then
+      iProj.PCategory = iProjects(iProj.Project)
+      Call iProjects.Remove(iProj.Project)
+      Call iProj.Increment
+    Else
+      Call iOut.ImportFrom(iProj)
+      Call iOut.Increment
+      Call iProj.RemoveRow
+    End If
+  Loop
+End Function
+
+Private Function AddNewActive(iActive As DB_Projects, iProjects As Scripting.Dictionary)
+  Dim iOut As IteratorProject: Set iOut = iActive.INew
+  Dim aKey As Variant
+  For Each aKey In iProjects
+    iOut.Project = CStr(aKey)
+    iOut.PCategory = iProjects(aKey)
+    Call iOut.Increment
+  Next aKey
+End Function

src/projects/z_UIRibbon.bas

@@ -0,0 +1,10 @@
+Attribute VB_Name = "z_UIRibbon"
+Option Explicit
+Option Private Module
+
+Public Sub OnRibbonBtn(iControl As IRibbonControl)
+  Select Case iControl.ID
+  Case "Update":                Call RunUpdate
+  Case "Sort":                  Call RunSort
+  End Select
+End Sub

src/worker/CRD_NewYear.frm

@@ -0,0 +1,51 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CRD_NewYear 
+   Caption         =   "Íîâûé ãîä"
+   ClientHeight    =   1395
+   ClientLeft      =   45
+   ClientTop       =   390
+   ClientWidth     =   4710
+   OleObjectBlob   =   "CRD_NewYear.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "CRD_NewYear"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Public isCanceled_ As Boolean
+
+Private Sub UserForm_Initialize()
+  isCanceled_ = True
+  Call PositionInMiddle(Me)
+End Sub
+
+Public Function Init()
+  isCanceled_ = True
+  
+  Call ComboBox1.Clear
+  
+  Dim nYear&
+  For nYear = 2010 To 2030
+    Call ComboBox1.AddItem(nYear)
+  Next nYear
+
+  ComboBox1 = Year(Now())
+End Function
+
+Private Sub BtnOK_Click()
+  If IsNumeric(ComboBox1.Value) = False Or ComboBox1.Value = "" Then
+    Call UserInteraction.ShowMessage(EM_INPUT_INVALID_YEAR)
+    Exit Sub
+  End If
+
+  isCanceled_ = False
+  Me.Hide
+End Sub
+
+Private Sub BtnCancel_Click()
+   isCanceled_ = True
+   Me.Hide
+End Sub

src/worker/CRD_ProjectList.frm

@@ -0,0 +1,77 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CRD_ProjectList 
+   Caption         =   "Ïåðå÷åíü ïðîåêòîâ"
+   ClientHeight    =   7215
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   9315.001
+   OleObjectBlob   =   "CRD_ProjectList.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "CRD_ProjectList"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Public isCanceled_ As Boolean
+
+Private selected_ As String
+
+Private Sub UserForm_Initialize()
+  isCanceled_ = True
+  Call PositionInMiddle(Me)
+End Sub
+
+Public Function Init(iProjects As DB_CachedProjects)
+  isCanceled_ = True
+  selected_ = vbNullString
+  
+  Call LBFixed.Clear
+  Call LBIncome.Clear
+  Call LBOutcome.Clear
+  
+  Dim aKey As Variant
+  For Each aKey In iProjects.projects_
+    Dim sProject$: sProject = CStr(aKey)
+    Dim iProject As ItemCachedProject: Set iProject = iProjects.projects_(aKey)
+    If iProject.isActive_ Then
+      If Not CCTestProjectName(sProject) Then
+        Call LBFixed.AddItem(sProject)
+      ElseIf iProject.category_ = T_PCAT_INCOME Then
+        Call LBIncome.AddItem(sProject)
+      Else
+        Call LBOutcome.AddItem(sProject)
+      End If
+    End If
+  Next aKey
+End Function
+
+Public Function GetSelectedID() As String
+  GetSelectedID = selected_
+End Function
+
+' ========
+Private Sub LBFixed_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
+  selected_ = LBFixed.Value
+  isCanceled_ = False
+  Call Me.Hide
+End Sub
+
+Private Sub LBIncome_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
+  selected_ = LBIncome.Value
+  isCanceled_ = False
+  Call Me.Hide
+End Sub
+
+Private Sub LBOutcome_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
+  selected_ = LBOutcome.Value
+  isCanceled_ = False
+  Call Me.Hide
+End Sub
+
+Private Sub BtnCancel_Click()
+  isCanceled_ = True
+  Call Me.Hide
+End Sub

src/worker/CRD_WorkList.frm

@@ -0,0 +1,62 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CRD_WorkList 
+   Caption         =   "Ïåðå÷åíü âèäîâ ðàáîò"
+   ClientHeight    =   9360.001
+   ClientLeft      =   45
+   ClientTop       =   375
+   ClientWidth     =   10140
+   OleObjectBlob   =   "CRD_WorkList.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "CRD_WorkList"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Public isCanceled_ As Boolean
+Private ids_ As Collection
+
+Private Sub UserForm_Initialize()
+  isCanceled_ = True
+  Call PositionInMiddle(Me)
+End Sub
+
+Public Function Init(iWorks As Scripting.Dictionary)
+  isCanceled_ = True
+  Call Me.LevelList.Clear
+  Set ids_ = New Collection
+  
+  Dim aKey As Variant
+  For Each aKey In iWorks
+    Call ids_.Add(aKey)
+    Call Me.LevelList.AddItem(aKey & ": " & iWorks(aKey))
+  Next aKey
+End Function
+
+Public Function GetSelectedID() As String
+  Dim nItem&
+  For nItem = 0 To ids_.Count - 1
+    If LevelList.Selected(nItem) Then
+      GetSelectedID = ids_.Item(nItem + 1)
+      Exit Function
+    End If
+  Next nItem
+End Function
+
+' ========
+Private Sub LevelList_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
+  Call BtnOK_Click
+End Sub
+
+Private Sub BtnOK_Click()
+  isCanceled_ = False
+  Call Me.Hide
+End Sub
+
+Private Sub BtnCancel_Click()
+  isCanceled_ = True
+  Call Me.Hide
+End Sub
+

src/worker/DataAccess.bas

@@ -0,0 +1,42 @@
+Attribute VB_Name = "DataAccess"
+Option Private Module
+Option Explicit
+
+Public Function AccessWorker(iSource As Excel.Workbook) As DB_WorkerData
+  Set AccessWorker = New DB_WorkerData
+  Call AccessWorker.Init(iSource)
+End Function
+
+Public Function AccessWorkTypes(iSource As Excel.Workbook) As Scripting.Dictionary
+  Dim iWorks As New Scripting.Dictionary
+  Dim iSheet As Excel.Worksheet
+  Dim iTable As Excel.ListObject: Set iTable = iSource.Sheets(SHEET_OPTIONS).ListObjects(TABLE_WORKS)
+  Dim nRow&
+  For nRow = 1 To iTable.ListRows.Count
+    Dim sWorkID$: sWorkID = iTable.ListRows(nRow).Range.Cells(1, 1)
+    Dim sWorkInfo$: sWorkInfo = iTable.ListRows(nRow).Range.Cells(1, 2)
+    Call iWorks.Add(sWorkID, sWorkInfo)
+  Next nRow
+  Set AccessWorkTypes = iWorks
+End Function
+
+Public Function AccessProjects() As DB_CachedProjects
+  Static s_Projects As DB_CachedProjects
+  
+  If s_Projects Is Nothing Then
+    Dim xlApp As New API_XLWrapper: Call xlApp.CreateApplication(bIsVisible:=False)
+    Dim iSource As Excel.Workbook: Set iSource = xlApp.OpenDocument(PATH_PROJECTS, bReadOnly:=True)
+    If iSource Is Nothing Then
+      Call UserInteraction.ShowMessage(EM_CANNOT_ACCESS_PROJECTS, PATH_PROJECTS)
+      Exit Function
+    End If
+  
+    Set s_Projects = New DB_CachedProjects
+    Call s_Projects.Reload(iSource)
+    
+    Call xlApp.ReleaseDocument
+    Call xlApp.ReleaseApplication
+  End If
+  
+  Set AccessProjects = s_Projects
+End Function

src/worker/Declarations.bas

@@ -0,0 +1,28 @@
+Attribute VB_Name = "Declarations"
+Option Explicit
+Option Private Module
+
+Public Const PIVOT_FIRST_ROW = 2
+
+Public Const SHEET_PIVOT = "Ñâîäíàÿ òàáëèöà"
+Public Const SHEET_PIVOT_DATA = "Äàííûå"
+Public Const SHEET_OPTIONS = "Ïàðàìåòðû"
+
+Public Const TABLE_WORKS = "t_WorkTypes"
+
+Public Const ZAK_MAIL As String = "Kuchkarov@acconcept.ru"
+Public Const DAILY_REPORT_SUBJECT As String = "Îò÷¸ò çà äåíü"
+
+Public Enum PivotStructure
+  [_First] = 1
+  
+  S_P_DATE = 1
+  S_P_YEAR = 2
+  S_P_IO = 3
+  S_P_PROJECT = 4
+  S_P_HOURS = 5
+  S_P_WORK_TYPE = 6
+  S_P_CONTENTS = 7
+  
+  [_Last] = 7
+End Enum

src/worker/DevHelper.bas

@@ -0,0 +1,21 @@
+Attribute VB_Name = "DevHelper"
+Option Private Module
+Option Explicit
+
+Public Function Dev_PrepareSkeleton()
+  ' Do nothing
+End Function
+
+Public Function Dev_ManualRunTest()
+  Dim sSuite$: sSuite = "s_UndoWrapper"
+  Dim sTest$: sTest = "t_BasicUndo"
+  Dim sMsg$: sMsg = Dev_RunTestDebug(sSuite, sTest)
+  Debug.Print sMsg
+  Call MsgBox(sMsg)
+End Function
+
+Public Function Dev_GetTestSuite(sName$) As Object
+  Select Case sName
+  '  Case "s_ParseDate": Set Dev_GetTestSuite = New s_ParseDate
+  End Select
+End Function

src/worker/Main.bas

@@ -0,0 +1,142 @@
+Attribute VB_Name = "Main"
+'============ Ìîäóëü îáñëóæèâàåò ðàáîòó ñèñòåìû ó÷åòà âðåìåíè =================
+Option Explicit
+Option Private Module
+
+Public Sub CR_AddYear()
+  Dim iTarget As Excel.Workbook: Set iTarget = ActiveWorkbook
+  Dim nYear%: nYear = PromptYear()
+  If nYear = 0 Then _
+    Exit Sub
+  
+  Dim xlApp As New API_XLWrapper: Call xlApp.SetApplication(ThisWorkbook.Application)
+  Dim iSource As Excel.Workbook: Set iSource = xlApp.OpenDocument(PATH_CALENDAR, bReadOnly:=True)
+  If iSource Is Nothing Then
+    Call UserInteraction.ShowMessage(EM_ADD_YEAR_NO_ACCESS, PATH_CALENDAR)
+    Exit Sub
+  End If
+  
+  Dim iData As DB_WorkerData: Set iData = AccessWorker(iTarget)
+  Dim bYearFound As Boolean: bYearFound = XLWorksheetExists(CStr(nYear), iSource)
+    
+  Call xlApp.PauseUI
+  If bYearFound Then
+    Call iData.ImportYear(iSource.Sheets(CStr(nYear)))
+  Else
+    Call iData.CreateYear(nYear)
+  End If
+  Call xlApp.ResumeUI
+  Call xlApp.ReleaseDocument
+  
+  Call UserInteraction.ShowMessage(IIf(bYearFound, IM_ADD_YEAR_AUTO, IM_ADD_YEAR_MANUAL))
+End Sub
+
+Public Sub CR_AddWorkType()
+  Dim target As Excel.Workbook: Set target = ActiveWorkbook
+  Dim sWork$: sWork = PromptWorkTypeID(AccessWorkTypes(target))
+  If sWork = vbNullString Then _
+    Exit Sub
+  
+  target.Application.Selection = sWork
+End Sub
+
+Public Sub CR_AddActiveProject()
+  Dim target As Excel.Workbook: Set target = ActiveWorkbook
+  Dim sProject$: sProject = PromptActiveProject(AccessProjects)
+  If sProject = vbNullString Then _
+    Exit Sub
+  
+  target.Application.Selection = sProject
+End Sub
+
+Public Sub CR_InfoProjects()
+  Dim xlApp As New API_XLWrapper: Call xlApp.SetApplication(ThisWorkbook.Application)
+  Dim iProjects As Excel.Workbook: Set iProjects = xlApp.OpenDocument(PATH_PROJECTS, bReadOnly:=True)
+  If iProjects Is Nothing Then
+    Call UserInteraction.ShowMessage(EM_CANNOT_ACCESS_PROJECTS, PATH_PROJECTS)
+    Exit Sub
+  End If
+End Sub
+
+Public Sub CR_InfoCalendar()
+  Call UserInteraction.FollowHyperlink(ActiveWorkbook, URL_CALENDAR_CONSULTANT & "/" & VBA.Year(VBA.Now))
+End Sub
+
+Public Sub CR_InfoExamples()
+  Dim xlApp As New API_XLWrapper: Call xlApp.SetApplication(ThisWorkbook.Application)
+  Dim iProjects As Excel.Workbook: Set iProjects = xlApp.OpenDocument(PATH_SAMPLES, bReadOnly:=True)
+  If iProjects Is Nothing Then
+    Call UserInteraction.ShowMessage(EM_CANNOT_ACCESS_SAMPLES, PATH_SAMPLES)
+    Exit Sub
+  End If
+End Sub
+
+Public Sub CR_DailyReport()
+  Dim iTarget As Excel.Workbook: Set iTarget = ActiveWorkbook
+  Dim targetDate&: targetDate = PromptDate(GetActiveDay(iTarget))
+  If targetDate = 0 Then _
+    Exit Sub
+  
+  Dim iData As DB_WorkerData: Set iData = AccessWorker(iTarget)
+  Dim sDescription$: sDescription = GenerateDayDescription(targetDate, iData)
+  If sDescription = vbNullString Then
+    Call UserInteraction.ShowMessage(EM_DAILY_NO_WORKS)
+    Exit Sub
+  End If
+  
+  If Not CreateDailyMessage(targetDate, sDescription) Then _
+    Call UserInteraction.ShowMessage(EM_CANNOT_CREATE_MAIL)
+End Sub
+
+Public Sub CR_MonthlyReport()
+  Dim iTarget As Excel.Workbook: Set iTarget = ActiveWorkbook
+  Dim targetDate&: targetDate = PromptDate(GetActiveDay(iTarget))
+  If targetDate = 0 Then _
+    Exit Sub
+  
+  Dim iData As DB_WorkerData: Set iData = AccessWorker(iTarget)
+  Dim theWrap As New API_XLWrapper: Call theWrap.SetApplication(ThisWorkbook.Application)
+  Dim iDoc As Excel.Workbook: Set iDoc = theWrap.NewDocument(PATH_MONTHLY_TEMPLATE)
+  If iDoc Is Nothing Then
+    Call UserInteraction.ShowMessage(EM_INVALID_REPORT_TEMPLATE)
+    Exit Sub
+  End If
+  
+  Dim iReport As New MonthlyReport: Call iReport.Init(iDoc, iData, AccessProjects)
+  Call iReport.ImportData(VBA.Month(targetDate), VBA.Year(targetDate))
+  
+  Call UserInteraction.ShowMessage(IM_MONTH_REPORT_OK)
+End Sub
+
+Public Sub CR_UpdatePivot()
+  Dim iTarget As Excel.Workbook: Set iTarget = ActiveWorkbook
+  Dim iData As DB_WorkerData: Set iData = AccessWorker(iTarget)
+  
+  Call ReloadPivotData(iTarget.Sheets(SHEET_PIVOT_DATA), iData, AccessProjects)
+
+  Dim aPivot As Excel.PivotTable
+  Call iTarget.Sheets(SHEET_PIVOT).Activate
+  For Each aPivot In iTarget.Sheets(SHEET_PIVOT).PivotTables
+    With aPivot
+      .RefreshTable
+      .Update
+    End With
+  Next
+  
+  Call UserInteraction.ShowMessage(IM_UPDATE_PIVOT_OK)
+End Sub
+
+Public Sub CR_FixGroups()
+  Call AccessWorker(ActiveWorkbook).FixDataGroups
+End Sub
+
+Public Sub CR_DeleteHolidays()
+  Dim iData As DB_WorkerData: Set iData = AccessWorker(ActiveWorkbook)
+  
+  Dim xlUI As New API_XLWrapper: Call xlUI.SetApplication(ActiveWorkbook.Application)
+  Call xlUI.PauseUI
+  Dim nCount&: nCount = iData.DeleteHolidays
+  Call xlUI.ResumeUI
+  
+  Call UserInteraction.ShowMessage(IM_HOLIDAYS_DELETED, nCount)
+End Sub

src/worker/MainImpl.bas

@@ -0,0 +1,106 @@
+Attribute VB_Name = "MainImpl"
+Option Explicit
+Option Private Module
+
+Public Function GetActiveDay(iWhere As Excel.Workbook) As Long
+  GetActiveDay = VBA.Int(VBA.Now())
+  If iWhere.ActiveSheet.Name <> WORKER_SHEET_DATA Then _
+    Exit Function
+  Dim nRow&: nRow = iWhere.Application.Selection.Cells(1, 1).Row
+  On Error Resume Next
+  GetActiveDay = iWhere.Sheets(WORKER_SHEET_DATA).Cells(nRow, S_W_DATE)
+  On Error GoTo 0
+End Function
+
+Public Function PromptYear() As Integer
+  With CRD_NewYear
+    Call .Init
+    Call .Show
+    If .isCanceled_ Then _
+      Exit Function
+    PromptYear = .ComboBox1.Value
+  End With
+  Call Unload(CRD_NewYear)
+End Function
+
+Public Function PromptWorkTypeID(iData As Scripting.Dictionary) As String
+  With CRD_WorkList
+    Call .Init(iData)
+    Call .Show
+    If .isCanceled_ Then _
+      Exit Function
+    PromptWorkTypeID = .GetSelectedID
+  End With
+End Function
+
+Public Function PromptActiveProject(iData As DB_CachedProjects) As String
+  With CRD_ProjectList
+    Call .Init(iData)
+    Call .Show
+    If .isCanceled_ Then _
+      Exit Function
+    PromptActiveProject = .GetSelectedID
+  End With
+End Function
+
+Public Function GenerateDayDescription(nDay&, iData As DB_WorkerData) As String
+  Dim sText$
+  Dim iWork As IteratorWork: Set iWork = iData.IBegin
+  Call iWork.GoUntil(nDay)
+  Do While Not iWork.IsDone
+    If iWork.DDate <> nDay Then _
+      Exit Do
+    
+    If iWork.Duration <> 0 Then
+      If sText <> vbNullString Then _
+        sText = sText & vbNewLine
+      sText = sText & Fmt("{1} - {2} - {3}", iWork.Project, iWork.Duration, iWork.Description)
+    End If
+    Call iWork.Increment
+  Loop
+  GenerateDayDescription = sText
+End Function
+
+Public Function CreateDailyMessage(nDate&, sDescription$) As Boolean
+  CreateDailyMessage = False
+  On Error GoTo RETURN_FALSE
+  
+  Dim iDailyMsg As Outlook.MailItem: Set iDailyMsg = Outlook.Application.CreateItem(olMailItem)
+  With iDailyMsg
+    .To = ZAK_MAIL
+    .Subject = VBA.Format(nDate, "yyyymmdd") & " " & DAILY_REPORT_SUBJECT
+    .Body = VBA.Format(nDate, "yyyymmdd") & vbNewLine & vbNewLine & sDescription
+    .Display
+  End With
+    
+  CreateDailyMessage = True
+  Exit Function
+RETURN_FALSE:
+  On Error GoTo 0
+End Function
+
+Public Function ReloadPivotData(iOut As Excel.Worksheet, iData As DB_WorkerData, iProjects As DB_CachedProjects)
+  Call iOut.UsedRange.Offset(1).ClearContents
+  
+  Dim nRow&: nRow = PIVOT_FIRST_ROW
+  Dim iWork As IteratorWork: Set iWork = iData.IBegin
+  Do While Not iWork.IsDone
+    If iWork.Duration = 0 Then _
+      GoTo NEXT_WORK
+      
+    With iOut
+      .Cells(nRow, S_P_DATE) = iWork.DDate
+      .Cells(nRow, S_P_YEAR) = VBA.Year(iWork.DDate)
+      .Cells(nRow, S_P_IO) = CCCategoryToString(iProjects.GetProjectCategory(iWork.Project))
+      .Cells(nRow, S_P_PROJECT) = iWork.Project
+      .Cells(nRow, S_P_HOURS) = iWork.Duration
+      .Cells(nRow, S_P_WORK_TYPE) = iWork.WorkType
+      .Cells(nRow, S_P_CONTENTS) = iWork.Description
+    End With
+    
+    nRow = nRow + 1
+    
+NEXT_WORK:
+    Call iWork.Increment
+  Loop
+End Function

src/worker/MonthlyReport.cls

@@ -0,0 +1,199 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "MonthlyReport"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private source_ As DB_WorkerData
+Private projects_ As DB_CachedProjects
+
+Private out_ As Excel.Worksheet
+
+Private start_ As Long
+Private finish_ As Long
+Private projectHours_ As Scripting.Dictionary
+Private projectCategories_ As Scripting.Dictionary
+Private hoursTotal_ As Double
+Private hoursIncome_ As Double
+Private hoursOutcome_ As Double
+
+Private Enum ReportStruct
+  S_MR_PROJECT = 2
+  S_MR_WORK = 3
+  S_MR_DESCRIPTION = 4
+  S_MR_HOURS = 6
+  S_MR_DATE = 7
+  S_MR_PROXY = 10
+End Enum
+
+Private Const REPORT_SHEET_REPORT = "Îò÷åò"
+
+Private Const CELL_REPORT_WORKER_NAME = "c_WorkerName"
+Private Const CELL_REPORT_PERIOD = "c_Period"
+Private Const CELL_REPORT_INCOME = "c_Income"
+Private Const CELL_REPORT_OUTCOME = "c_Outcome"
+Private Const CELL_REPORT_TOTAL = "c_Total"
+
+Private Const REPORT_ROW_PROTOTYPE = 6
+Private Const REPORT_WORK_START = 7
+
+Public Function Init(iOut As Excel.Workbook, iSource As DB_WorkerData, iProjects As DB_CachedProjects)
+  Set out_ = iOut.Sheets(REPORT_SHEET_REPORT)
+  Set source_ = iSource
+  Set projects_ = iProjects
+End Function
+
+Public Function ImportData(nMonth%, nYear%)
+  start_ = VBA.DateSerial(nYear, nMonth, 1)
+  finish_ = VBA.DateSerial(nYear, nMonth + 1, 1) - 1
+  
+  Call FillHeader
+  Call FillWorks
+  Call FillTotals
+  
+  Dim r As Excel.Range
+  Call out_.Parent.Names(CELL_REPORT_INCOME).RefersToRange.Select
+End Function
+
+' =======
+Private Function FillHeader()
+  out_.Parent.Names(CELL_REPORT_WORKER_NAME).RefersToRange = source_.WorkerName
+  out_.Parent.Names(CELL_REPORT_PERIOD).RefersToRange = Fmt("çà ïåðèîä ñ {1} ïî {2}", VBA.CDate(start_), VBA.CDate(finish_))
+End Function
+
+Private Function FillWorks()
+  hoursTotal_ = 0
+  hoursIncome_ = 0
+  hoursOutcome_ = 0
+  Set projectHours_ = New Scripting.Dictionary
+  Set projectCategories_ = New Scripting.Dictionary
+  
+  Dim iWork As IteratorWork: Set iWork = source_.IBegin
+  Call iWork.GoUntil(start_)
+  
+  Dim nRow&: nRow = REPORT_WORK_START
+  Do While Not iWork.IsDone
+    Dim theDate&: theDate = iWork.DDate
+    If theDate > finish_ Then _
+      Exit Do
+    
+    Dim dDuration As Double: dDuration = iWork.Duration
+    If dDuration = 0 Then _
+      GoTo NEXT_WORK
+      
+    Dim sProject$: sProject = iWork.Project
+    If sProject = PROJECT_HOLIDAYS Then _
+      GoTo NEXT_WORK
+    
+    Call AddWork(nRow, theDate, sProject, iWork.WorkType, dDuration, iWork.Description, iWork.IsMergedDescription)
+    
+    nRow = nRow + 1
+    Call IncrementHours(sProject, dDuration)
+    
+NEXT_WORK:
+    Call iWork.Increment
+  Loop
+  
+  Call out_.Rows(nRow).Delete
+  Call out_.Rows(REPORT_ROW_PROTOTYPE).Delete
+End Function
+
+Private Function FillTotals()
+  Dim nIncomeHead&: nIncomeHead = out_.Parent.Names(CELL_REPORT_INCOME).RefersToRange.Row
+  Dim nOutcomeHead&: nOutcomeHead = out_.Parent.Names(CELL_REPORT_OUTCOME).RefersToRange.Row
+  out_.Parent.Names(CELL_REPORT_TOTAL).RefersToRange = hoursTotal_
+  Call SetTotalHours(nIncomeHead, hoursIncome_)
+  Call SetTotalHours(nOutcomeHead, hoursOutcome_)
+  
+  Dim nIncome&: nIncome = nIncomeHead + 2
+  Dim nOutcome&: nOutcome = nOutcomeHead + 2
+  Dim nPrototype&: nPrototype = nIncomeHead + 1
+  
+  Dim aKey As Variant
+  For Each aKey In projectCategories_
+    Dim sProject$: sProject = CStr(aKey)
+    Dim sManager$: sManager = projects_.GetProjectManager(sProject)
+    Dim dDuration As Double: dDuration = projectHours_(aKey)
+    If projectCategories_(aKey) = T_PCAT_INCOME Then
+      Call AddProject(nPrototype, nIncome, sProject, sManager, dDuration)
+      nIncome = nIncome + 1
+      nOutcomeHead = nOutcomeHead + 1
+      nOutcome = nOutcome + 1
+    Else
+      Call AddProject(nPrototype, nOutcome, sProject, sManager, dDuration)
+      nOutcome = nOutcome + 1
+    End If
+  Next aKey
+  
+  Call out_.Rows(nOutcome).Delete
+  Call out_.Rows(nOutcomeHead + 1).Delete
+  Call out_.Rows(nIncome).Delete
+  Call out_.Rows(nIncomeHead + 1).Delete
+End Function
+
+' =======
+Private Function AddWork(nRow&, theDate&, sProject$, sWork$, dDuration As Double, sDescription$, bIsMerged As Boolean)
+  Call out_.Rows(REPORT_ROW_PROTOTYPE).EntireRow.Copy
+  Call out_.Rows(nRow).EntireRow.Insert
+  out_.Cells(nRow, S_MR_PROJECT) = sProject
+  out_.Cells(nRow, S_MR_WORK) = sWork
+  out_.Cells(nRow, S_MR_HOURS) = dDuration
+  out_.Cells(nRow, S_MR_DATE) = theDate
+  If bIsMerged Then
+    Call AddMergedRow(nRow)
+  Else
+    out_.Cells(nRow, S_MR_DESCRIPTION) = sDescription
+  End If
+End Function
+
+Private Function AddProject(nPrototype&, nRow&, sProject$, sManager$, dDuration As Double)
+  Call out_.Rows(nPrototype).EntireRow.Copy
+  Call out_.Rows(nRow).EntireRow.Insert
+  out_.Cells(nRow, S_MR_PROJECT) = sProject
+  out_.Cells(nRow, S_MR_WORK) = sManager
+  Call SetTotalHours(nRow, dDuration)
+End Function
+
+Private Function AddMergedRow(nRow&)
+  Dim iPrevious As Excel.Range: Set iPrevious = out_.Cells(nRow - 1, S_MR_DESCRIPTION)
+  Dim nCount&
+  If iPrevious.MergeCells Then
+    nCount = iPrevious.MergeArea.Rows.Count
+  Else
+    nCount = 1
+  End If
+  
+  out_.Cells(nRow, S_MR_PROXY) = ""
+  out_.Cells(nRow - nCount, S_MR_PROXY) = ""
+
+  Dim iMergeArea As Excel.Range
+  Set iMergeArea = out_.Cells(nRow, S_MR_DESCRIPTION).Offset(-nCount, 0).Resize(nCount + 1, 2)
+  Call iMergeArea.UnMerge
+  Call iMergeArea.Merge
+End Function
+
+Private Function IncrementHours(sProject$, dDuration As Double)
+  If projectHours_.Exists(sProject) Then
+    projectHours_(sProject) = projectHours_(sProject) + dDuration
+  Else
+    Call projectHours_.Add(sProject, dDuration)
+    Call projectCategories_.Add(sProject, projects_.GetProjectCategory(sProject))
+  End If
+  hoursTotal_ = hoursTotal_ + dDuration
+  
+  If projectCategories_(sProject) = T_PCAT_INCOME Then
+    hoursIncome_ = hoursIncome_ + dDuration
+  Else
+    hoursOutcome_ = hoursOutcome_ + dDuration
+  End If
+End Function
+
+Private Function SetTotalHours(nRow&, dDuration As Double)
+  out_.Cells(nRow, S_MR_HOURS) = dDuration
+  out_.Cells(nRow, S_MR_DATE) = dDuration / hoursTotal_
+End Function

src/worker/z_UIMessages.bas

@@ -0,0 +1,74 @@
+Attribute VB_Name = "z_UIMessages"
+' Messaging module
+Option Private Module
+Option Explicit
+
+Public Enum MsgCode
+  EM_PROJECTS_EMPTY
+  EM_INPUT_INVALID_YEAR
+  EM_INVALID_REPORT_TEMPLATE
+  EM_CANNOT_ACCESS_PROJECTS
+  EM_ADD_YEAR_NO_ACCESS
+  EM_CANNOT_ACCESS_SAMPLES
+  EM_DAILY_NO_WORKS
+  EM_CANNOT_CREATE_MAIL
+  
+  IM_UPDATE_PIVOT_OK
+  IM_MONTH_REPORT_OK
+  IM_ADD_YEAR_AUTO
+  IM_ADD_YEAR_MANUAL
+  IM_HOLIDAYS_DELETED
+End Enum
+
+Private g_UI As API_UserInteraction
+
+Public Function UserInteraction() As API_UserInteraction
+  If g_UI Is Nothing Then _
+    Set g_UI = New API_UserInteraction
+  Set UserInteraction = g_UI
+End Function
+
+Public Function SetUserInteraction(newUI As API_UserInteraction)
+  Set g_UI = newUI
+End Function
+
+Public Function UIShowMessage(theCode As MsgCode, ParamArray params() As Variant)
+  Dim unwrapped As Variant: unwrapped = params
+  unwrapped = FixForwardedParams(unwrapped)
+  
+  Select Case theCode
+  Case IM_UPDATE_PIVOT_OK:            Call MsgBox("Ñâîäíàÿ òàáëèöà îáíîâëåíà", vbInformation)
+  Case IM_MONTH_REPORT_OK:            Call MsgBox("Åæåìåñÿ÷íûé îò÷åò ñãåíåðèðîâàí", vbInformation)
+  Case IM_HOLIDAYS_DELETED:           Call MsgBox(Fmt("Óäàëåíî ñòðîê: {1}", unwrapped), vbInformation)
+  Case IM_ADD_YEAR_AUTO:              Call MsgBox("Ãîä äîáàâëåí íà ëèñò ñîòðóäíèêà" & _
+                                                  vbNewLine & "Ïðàçäíè÷íûå äàòû ïåðåíåñåíû èç ïðîèçâîäñòâåííîãî êàëåíäàðÿ", vbInformation)
+  Case IM_ADD_YEAR_MANUAL:            Call MsgBox("Ãîä äîáàâëåí íà ëèñò ñîòðóäíèêà" & _
+                                                  vbNewLine & "Âíèìàíèå! Ïðàçäíè÷íûå äíè íåîáõîäèìî îòìå÷àòü âðó÷íóþ", vbInformation)
+  
+  Case EM_PROJECTS_EMPTY:             Call MsgBox("Ñïèñîê ïðîåêòîâ ïóñò", vbExclamation)
+  Case EM_INPUT_INVALID_YEAR:         Call MsgBox("Ââåäèòå ÷èñëîâîå çíà÷åíèå ãîäà", vbExclamation)
+  Case EM_INVALID_REPORT_TEMPLATE:    Call MsgBox("Íå óäàëîñü ñîçäàòü îò÷åò èç øàáëîíà", vbExclamation)
+  Case EM_CANNOT_ACCESS_PROJECTS:     Call MsgBox(Fmt("Íå óäàëîñü ïîëó÷èòü äîñòóï ê ñïèñêó ïðîåêòîâ" & vbNewLine & "{1}", unwrapped), vbExclamation)
+  Case EM_CANNOT_ACCESS_SAMPLES:      Call MsgBox(Fmt("Íå óäàëîñü ïîëó÷èòü äîñòóï ê ïðèìåðàì ðàáîò" & vbNewLine & "{1}", unwrapped), vbExclamation)
+  Case EM_ADD_YEAR_NO_ACCESS:         Call MsgBox(Fmt("Íå óäàëîñü ïîëó÷èòü äîñòóï ê ïðîèçâîäñòâåííîìó êàëåíäàðþ" & vbNewLine & "{1}", unwrapped), vbExclamation)
+  Case EM_DAILY_NO_WORKS:             Call MsgBox("Ðàáîòû çà äåíü îòñóòñòâóþò", vbExclamation)
+  Case EM_CANNOT_CREATE_MAIL:         Call MsgBox("Íå óäàëîñü ñîçäàòü ïèñüìî â Outlook", vbExclamation)
+  
+  Case Else:                          Call MsgBox("Íåâåðíûé êîä ñîîáùåíèÿ", vbCritical)
+  End Select
+End Function
+
+Public Function UIAskQuestion(theCode As MsgCode, ParamArray params() As Variant) As Boolean
+  Dim unwrapped As Variant: unwrapped = params
+  unwrapped = FixForwardedParams(unwrapped)
+  
+  Dim answer&: answer = vbNo
+  Select Case theCode
+  'Case QM_CODE_DELETE_CONFIRM
+  '  answer = MsgBox("Are you sure you want to delete ALL macros from target file?", vbYesNo + vbQuestion)
+    
+  Case Else
+    Call MsgBox("Íåâåðíûé êîä ñîîáùåíèÿ", vbCritical)
+  End Select
+  UIAskQuestion = answer = vbYes
+End Function

src/worker/z_UIRibbon.bas

@@ -0,0 +1,26 @@
+Attribute VB_Name = "z_UIRibbon"
+Option Explicit
+Option Private Module
+
+Public Sub CR_OnRibbonBtn(iControl As IRibbonControl)
+  Select Case iControl.ID
+  Case "CRAddYear":               Call CR_AddYear
+  Case "CRAddWorkType":           Call CR_AddWorkType
+  Case "CRAddActiveProject":      Call CR_AddActiveProject
+  
+  Case "CRMonthReport":           Call CR_MonthlyReport
+  Case "CRDailyReport":           Call CR_DailyReport
+  Case "CRUpdateData":            Call CR_UpdatePivot
+  
+  Case "CRInfoProjects":          Call CR_InfoProjects
+  Case "CRInfoCalendar":          Call CR_InfoCalendar
+  Case "CRInfoExamples":          Call CR_InfoExamples
+  
+  Case "CRFixGroups":             Call CR_FixGroups
+  Case "CRDeleteHolidays":        Call CR_DeleteHolidays
+  End Select
+End Sub
+
+Public Sub CR_RibbonReportEnabled(iControl As IRibbonControl, ByRef returnedVal)
+  returnedVal = ValidateReport(ActiveWorkbook)
+End Sub

ui/aggregator/.rels

@@ -0,0 +1,2 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships"><Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument" Target="xl/workbook.xml"/><Relationship Id="rId6" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/><Relationship Id="rId5" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/><Relationship Id="rId4" Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml"/></Relationships>

ui/aggregator/customUI.xml

@@ -0,0 +1,42 @@
+<?xml version="1.0" encoding="utf-8"?>
+<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
+	<ribbon>
+	<tabs>
+	<tab id="AllReports" label="ВСЕУЧЕТ">
+	<group id="Actions" label="Действия">
+		<menu label="Сотрудник" id="MenuWorkers" imageMso="ArrangeByAccount" size="large">
+			<button id="AddWorker" label="Добавить"
+				supertip="Добавить сотрудника"
+				imageMso="AddAccount"
+				onAction="OnRibbonBtn"/>
+			<button id="ReloadWorker" label="Перезагрузить"
+				supertip="Для выделенного сотрудника загрузить данные учета рабочего времени"
+				imageMso="DataDesignWorkflow"
+				onAction="OnRibbonBtn"/>
+			<button id="RemoveWorker" label="Архивировать"
+				supertip="Пометить сотрудника как уволившегося"
+				imageMso="ContactDelete"
+				onAction="OnRibbonBtn"/>
+		</menu>
+		
+		<button id="ReloadAll" size="large" 
+			label="Обновить все"
+			supertip="Перезагрузить данные всех активных сотрудников" 
+			imageMso="GroupPivotChartDataAccess"
+			onAction="OnRibbonBtn"/>
+		
+		<menu label="Справка" id="MenuInfo" imageMso="TipWizardHelp" size="large">
+			<button id="InfoProjects" label="Все проекты"
+				supertip="Открыть справочник по всем проектам"
+				imageMso="CreateDiagram"
+				onAction="OnRibbonBtn"/>
+			<button id="InfoCalendar" label="Производственный календарь"
+				supertip="Открыть производственный календарь на текущий год"
+				imageMso="GotoCalendar"
+				onAction="OnRibbonBtn"/>
+		</menu>
+	</group>
+	</tab>
+	</tabs>
+	</ribbon>
+</customUI>

ui/projects/.rels

@@ -0,0 +1,2 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships"><Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument" Target="xl/workbook.xml"/><Relationship Id="rId6" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/><Relationship Id="rId5" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/><Relationship Id="rId4" Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml"/></Relationships>

ui/projects/customUI.xml

@@ -0,0 +1,21 @@
+<?xml version="1.0" encoding="utf-8"?>
+<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
+	<ribbon>
+	<tabs>
+	<tab id="Projects" label="ПРОЕКТЫ" >	
+	<group id="Actions" label="Действия">
+		<button id="Update" size="large" 
+			label="Обновить"
+			supertip="Обновить список проектов в соовтетствии с рабочими папками" 
+			imageMso="ArrangeByRecurrence"
+			onAction="OnRibbonBtn"/>
+		<button id="Sort" size="large" 
+			label="Сортировать"
+			supertip="Обновить сортировку списка проектов после ручного редактирования" 
+			imageMso="GroupPivotDiagramSort"
+			onAction="OnRibbonBtn"/>
+	</group>
+	</tab>
+	</tabs>
+	</ribbon>
+</customUI>

ui/worker/.rels

@@ -0,0 +1,2 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships"><Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument" Target="xl/workbook.xml"/><Relationship Id="rId6" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/><Relationship Id="rId5" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/><Relationship Id="rId4" Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml"/></Relationships>

ui/worker/customUI.xml

@@ -0,0 +1,67 @@
+<?xml version="1.0" encoding="utf-8"?>
+<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
+			xmlns:CC="Concept Namespace">
+	<ribbon startFromScratch="false" >
+	<tabs>
+	<tab idQ="CC:CustomBtns" label="КОНЦЕПТ" >	
+	<group id="Group2" label="Учет времени / Отчеты" getVisible="CR_RibbonReportEnabled">
+		<menu label="Вставка" id="CRMenuInsert" imageMso="SearchFormFields" size="large">
+			<button id="CRAddWorkType" label="Тип работы"
+				supertip="Список работ с полными названиями"
+				imageMso="WorkOffline"
+				onAction="CR_OnRibbonBtn"/>
+			<button id="CRAddActiveProject" label="Активный проект"
+				supertip="Список работ с полными названиями"
+				imageMso="RulesManageAndCreate"
+				onAction="CR_OnRibbonBtn"/>
+			<button id="CRAddYear" label="Новый год"
+				supertip="Добавить пустые строчки для заданного года"
+				imageMso="StartAfterPrevious"
+				onAction="CR_OnRibbonBtn"/>
+		</menu>
+		
+		<menu label="Отчеты" id="CRMenuReport" imageMso="TableBorderColorMoreColorsDialog" size="large">
+			<button id="CRMonthReport" label="Отчет за месяц"
+				supertip="Сгенерировать отчета за месяц"
+				imageMso="AdpDiagramNewTable"
+				onAction="CR_OnRibbonBtn"/>
+			<button id="CRDailyReport" label="Отчет за день"
+				supertip="Сгенерировать ежедневный отчет"
+				imageMso="Forward"
+				onAction="CR_OnRibbonBtn"/>
+			<button id="CRUpdateData" label="Сводный отчет (Pivot)"
+				supertip="Обновить данные сводного отчета"
+				imageMso="CreateQueryFromWizard"
+				onAction="CR_OnRibbonBtn"/>
+		</menu>
+		
+		<menu label="Справка" id="CRMenuInfo" imageMso="TipWizardHelp" size="large">
+			<button id="CRInfoProjects" label="Все проекты"
+				supertip="Открыть справочник по всем проектам"
+				imageMso="CreateDiagram"
+				onAction="CR_OnRibbonBtn"/>
+			<button id="CRInfoCalendar" label="Производственный календарь"
+				supertip="Открыть производственный календарь на текущий год"
+				imageMso="GotoCalendar"
+				onAction="CR_OnRibbonBtn"/>
+			<button id="CRInfoExamples" label="Примеры проектов и типов работ"
+				supertip="Открыть файл с примерами отнесения работ к стандартным типа и общим проектам"
+				imageMso="RtcShareCurrentSession"
+				onAction="CR_OnRibbonBtn"/>
+		</menu>
+
+		<menu label="Обработка" id="CRMenuTransform" imageMso="AnimationTriggerAddMenu" size="large">
+			<button id="CRFixGroups" label="Группировка"
+				supertip="Исправить группировку на листе работ"
+				imageMso="GroupMacroRows"
+				onAction="CR_OnRibbonBtn"/>
+			<button id="CRDeleteHolidays" label="Удалить выходные"
+				supertip="Удалить строки с праздниками и выходными"
+				imageMso="GroupActions"
+				onAction="CR_OnRibbonBtn"/>
+		</menu>
+	</group>
+	</tab>
+	</tabs>
+	</ribbon>
+</customUI>