commit 29c352dfd1ad9386fbc759fe86f036fc9fb1dbf1 Author: IRBorisov <8611739+IRBorisov@users.noreply.github.com> Date: Fri Jun 7 20:12:58 2024 +0300 Initial commit diff --git a/VBAMake.txt b/VBAMake.txt new file mode 100644 index 0000000..8812b2c --- /dev/null +++ b/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 \ No newline at end of file diff --git a/VERSION b/VERSION new file mode 100644 index 0000000..9084fa2 --- /dev/null +++ b/VERSION @@ -0,0 +1 @@ +1.1.0 diff --git a/distr/80 Учет рабочего времени.xltx b/distr/80 Учет рабочего времени.xltx new file mode 100644 index 0000000..89638d1 Binary files /dev/null and b/distr/80 Учет рабочего времени.xltx differ diff --git a/distr/90 Ежемесячный отчет.xltx b/distr/90 Ежемесячный отчет.xltx new file mode 100644 index 0000000..7fd000b Binary files /dev/null and b/distr/90 Ежемесячный отчет.xltx differ diff --git a/distr/Примеры работ.xlsx b/distr/Примеры работ.xlsx new file mode 100644 index 0000000..f39c092 Binary files /dev/null and b/distr/Примеры работ.xlsx differ diff --git a/distr/Производственный календарь.xlsx b/distr/Производственный календарь.xlsx new file mode 100644 index 0000000..06ae761 Binary files /dev/null and b/distr/Производственный календарь.xlsx differ diff --git a/script/aggregator.txt b/script/aggregator.txt new file mode 100644 index 0000000..1645481 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/script/projects.txt b/script/projects.txt new file mode 100644 index 0000000..a2959b0 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/script/worker.txt b/script/worker.txt new file mode 100644 index 0000000..92db141 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/skeleton/!Всеучёт.xlsm b/skeleton/!Всеучёт.xlsm new file mode 100644 index 0000000..c5b38f2 Binary files /dev/null and b/skeleton/!Всеучёт.xlsm differ diff --git a/skeleton/!Список проектов.xlsm b/skeleton/!Список проектов.xlsm new file mode 100644 index 0000000..a4fdb40 Binary files /dev/null and b/skeleton/!Список проектов.xlsm differ diff --git a/skeleton/ConceptReport.xlsm b/skeleton/ConceptReport.xlsm new file mode 100644 index 0000000..fbf2720 Binary files /dev/null and b/skeleton/ConceptReport.xlsm differ diff --git a/src/aggregator/CreateWorkerDlg.frm b/src/aggregator/CreateWorkerDlg.frm new file mode 100644 index 0000000..c7a7bfe --- /dev/null +++ b/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 diff --git a/src/aggregator/CreateWorkerDlg.frx b/src/aggregator/CreateWorkerDlg.frx new file mode 100644 index 0000000..e55cec9 Binary files /dev/null and b/src/aggregator/CreateWorkerDlg.frx differ diff --git a/src/aggregator/DB_GlobalWorks.cls b/src/aggregator/DB_GlobalWorks.cls new file mode 100644 index 0000000..694f72d --- /dev/null +++ b/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 diff --git a/src/aggregator/DB_Workers.cls b/src/aggregator/DB_Workers.cls new file mode 100644 index 0000000..c8d54e7 --- /dev/null +++ b/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 diff --git a/src/aggregator/DataAccess.bas b/src/aggregator/DataAccess.bas new file mode 100644 index 0000000..3ecd6f6 --- /dev/null +++ b/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 diff --git a/src/aggregator/Declarations.bas b/src/aggregator/Declarations.bas new file mode 100644 index 0000000..47a9ab9 --- /dev/null +++ b/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 diff --git a/src/aggregator/DevHelper.bas b/src/aggregator/DevHelper.bas new file mode 100644 index 0000000..4ffb5c9 --- /dev/null +++ b/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 diff --git a/src/aggregator/ItemInputWorker.cls b/src/aggregator/ItemInputWorker.cls new file mode 100644 index 0000000..4ce574a --- /dev/null +++ b/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 diff --git a/src/aggregator/IteratorGlobalWork.cls b/src/aggregator/IteratorGlobalWork.cls new file mode 100644 index 0000000..e70b656 --- /dev/null +++ b/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 diff --git a/src/aggregator/IteratorWorker.cls b/src/aggregator/IteratorWorker.cls new file mode 100644 index 0000000..fb8c852 --- /dev/null +++ b/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 diff --git a/src/aggregator/Main.bas b/src/aggregator/Main.bas new file mode 100644 index 0000000..1749bf4 --- /dev/null +++ b/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 diff --git a/src/aggregator/MainImpl.bas b/src/aggregator/MainImpl.bas new file mode 100644 index 0000000..dcb9d1d --- /dev/null +++ b/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 + diff --git a/src/aggregator/z_UIMessages.bas b/src/aggregator/z_UIMessages.bas new file mode 100644 index 0000000..0847225 --- /dev/null +++ b/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 diff --git a/src/aggregator/z_UIRibbon.bas b/src/aggregator/z_UIRibbon.bas new file mode 100644 index 0000000..1504b33 --- /dev/null +++ b/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 diff --git a/src/common/DB_CachedProjects.cls b/src/common/DB_CachedProjects.cls new file mode 100644 index 0000000..fb7aec0 --- /dev/null +++ b/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 diff --git a/src/common/DB_Projects.cls b/src/common/DB_Projects.cls new file mode 100644 index 0000000..bd5f8b4 --- /dev/null +++ b/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 + diff --git a/src/common/DB_WorkerData.cls b/src/common/DB_WorkerData.cls new file mode 100644 index 0000000..e306222 --- /dev/null +++ b/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 diff --git a/src/common/DataTransfer.bas b/src/common/DataTransfer.bas new file mode 100644 index 0000000..ce19c69 --- /dev/null +++ b/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 + diff --git a/src/common/DeclarationsWorker.bas b/src/common/DeclarationsWorker.bas new file mode 100644 index 0000000..d45c1f6 --- /dev/null +++ b/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 diff --git a/src/common/ItemCachedProject.cls b/src/common/ItemCachedProject.cls new file mode 100644 index 0000000..ba6fd5c --- /dev/null +++ b/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 diff --git a/src/common/IteratorProject.cls b/src/common/IteratorProject.cls new file mode 100644 index 0000000..468348a --- /dev/null +++ b/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 + diff --git a/src/common/IteratorWork.cls b/src/common/IteratorWork.cls new file mode 100644 index 0000000..a82fe0b --- /dev/null +++ b/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 + diff --git a/src/projects/DataAccess.bas b/src/projects/DataAccess.bas new file mode 100644 index 0000000..f101361 --- /dev/null +++ b/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 diff --git a/src/projects/Declarations.bas b/src/projects/Declarations.bas new file mode 100644 index 0000000..6939aaa --- /dev/null +++ b/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 diff --git a/src/projects/Main.bas b/src/projects/Main.bas new file mode 100644 index 0000000..93e617e --- /dev/null +++ b/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 + + diff --git a/src/projects/MainImpl.bas b/src/projects/MainImpl.bas new file mode 100644 index 0000000..3b441b4 --- /dev/null +++ b/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 diff --git a/src/projects/z_UIRibbon.bas b/src/projects/z_UIRibbon.bas new file mode 100644 index 0000000..df1779f --- /dev/null +++ b/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 diff --git a/src/worker/CRD_NewYear.frm b/src/worker/CRD_NewYear.frm new file mode 100644 index 0000000..2ca4be5 --- /dev/null +++ b/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 diff --git a/src/worker/CRD_NewYear.frx b/src/worker/CRD_NewYear.frx new file mode 100644 index 0000000..756f596 Binary files /dev/null and b/src/worker/CRD_NewYear.frx differ diff --git a/src/worker/CRD_ProjectList.frm b/src/worker/CRD_ProjectList.frm new file mode 100644 index 0000000..ce3ea2a --- /dev/null +++ b/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 diff --git a/src/worker/CRD_ProjectList.frx b/src/worker/CRD_ProjectList.frx new file mode 100644 index 0000000..480c26d Binary files /dev/null and b/src/worker/CRD_ProjectList.frx differ diff --git a/src/worker/CRD_WorkList.frm b/src/worker/CRD_WorkList.frm new file mode 100644 index 0000000..be24a62 --- /dev/null +++ b/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 + diff --git a/src/worker/CRD_WorkList.frx b/src/worker/CRD_WorkList.frx new file mode 100644 index 0000000..971f972 Binary files /dev/null and b/src/worker/CRD_WorkList.frx differ diff --git a/src/worker/DataAccess.bas b/src/worker/DataAccess.bas new file mode 100644 index 0000000..c491419 --- /dev/null +++ b/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 diff --git a/src/worker/Declarations.bas b/src/worker/Declarations.bas new file mode 100644 index 0000000..bb641ca --- /dev/null +++ b/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 diff --git a/src/worker/DevHelper.bas b/src/worker/DevHelper.bas new file mode 100644 index 0000000..200b1f5 --- /dev/null +++ b/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 diff --git a/src/worker/Main.bas b/src/worker/Main.bas new file mode 100644 index 0000000..21686de --- /dev/null +++ b/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 diff --git a/src/worker/MainImpl.bas b/src/worker/MainImpl.bas new file mode 100644 index 0000000..01e1ba2 --- /dev/null +++ b/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 diff --git a/src/worker/MonthlyReport.cls b/src/worker/MonthlyReport.cls new file mode 100644 index 0000000..5c0862f --- /dev/null +++ b/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 diff --git a/src/worker/z_UIMessages.bas b/src/worker/z_UIMessages.bas new file mode 100644 index 0000000..e805c30 --- /dev/null +++ b/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 diff --git a/src/worker/z_UIRibbon.bas b/src/worker/z_UIRibbon.bas new file mode 100644 index 0000000..eff0211 --- /dev/null +++ b/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 diff --git a/ui/aggregator/.rels b/ui/aggregator/.rels new file mode 100644 index 0000000..3107a8e --- /dev/null +++ b/ui/aggregator/.rels @@ -0,0 +1,2 @@ + + \ No newline at end of file diff --git a/ui/aggregator/customUI.xml b/ui/aggregator/customUI.xml new file mode 100644 index 0000000..fb4c53e --- /dev/null +++ b/ui/aggregator/customUI.xml @@ -0,0 +1,42 @@ + + + + + + + + + +