commit bffee727b58a475de6ab0e87088130addaf5d69d Author: IRBorisov <8611739+IRBorisov@users.noreply.github.com> Date: Fri Jun 7 19:54:55 2024 +0300 Initial commit diff --git a/VBAMake.txt b/VBAMake.txt new file mode 100644 index 0000000..7140d3f --- /dev/null +++ b/VBAMake.txt @@ -0,0 +1,33 @@ +# == Properties Section == +# configuration properties +# use .ini format to define properties +# mandatory properties: name, artifact_home, source_home + +id = BatchAI +name = BatchAI +description = Пакетная обработка файлов +artifact_home = BatchAI +source_home = BatchAI +install_home = \\fs1.concept.ru\projects\10 Автоматизация деятельности\02 Офисная автоматизация\00 Обработчики + +%% +# === Build section === +# Available commands: +# build LOCAL_MANIFEST +# copy LOCAL_SOURCE -> [LOCAL_ARTIFACT] +# save_as LOCAL_ARTIFACT -> LOCAL_ARTIFACT +# run LOCAL_SOURCE.bat + +copy distr\Шаблоны -> Шаблоны +build script\MainProcessor.txt + +%% +# === Install section == +# Available commands: +# install LOCAL_ARTIFACT -> [INSTALL_PATH] +# add_template LOCAL_ARTIFACT -> [LOCAL_TEMPLATE] +# run LOCAL_ARTIFACT.bat <- [PARAMETERS] +# run APPLICATION <- [PARAMETERS] + +install Шаблоны +install !Пакетная обработка.xlsm \ No newline at end of file diff --git a/VERSION b/VERSION new file mode 100644 index 0000000..f0bb29e --- /dev/null +++ b/VERSION @@ -0,0 +1 @@ +1.3.0 diff --git a/distr/Шаблоны/Полномочия.xltx b/distr/Шаблоны/Полномочия.xltx new file mode 100644 index 0000000..29beb18 Binary files /dev/null and b/distr/Шаблоны/Полномочия.xltx differ diff --git a/script/MainProcessor.txt b/script/MainProcessor.txt new file mode 100644 index 0000000..6dcc764 --- /dev/null +++ b/script/MainProcessor.txt @@ -0,0 +1,100 @@ +# == 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 + +api + ex_WinAPI.bas + ex_Python.bas + + API_Python.cls + API_UserInteraction.cls + API_XLWrapper.cls + API_VsoWrapper.cls + API_WordWrapper.cls + +utility + ex_VBA.bas + ex_Regex.bas + ex_DataPreparation.bas + + API_Config.cls + API_JSON.cls + API_Timer.cls + +excel + ex_Excel.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 + processor + DataAccess.bas + DevHelper.bas + Declarations.bas + Main.bas + MainImpl.bas + z_UIMessages.bas + z_UIRibbon.bas + + OptionsSubstitutes.cls + + AProcessor.cls + ProcessorSubstitute.cls + ProcessorOrders.cls + ProcessorSaveAs.cls + ProcessorMasterDoc.cls + ProcessorFormatMine.cls + + DB_Substitutes.cls + DB_Sources.cls + + IteratorSource.cls + IteratorSubstitute.cls + + test + s_DBSources.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 + +processor\.rels -> _rels\.rels +processor\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 : MSForms +global : Scripting +global : Visio +global : Word +global : VBScript_RegExp_55 +global : Shell32 +global : ADODB \ No newline at end of file diff --git a/skeleton/!Пакетная обработка.xlsm b/skeleton/!Пакетная обработка.xlsm new file mode 100644 index 0000000..131063d Binary files /dev/null and b/skeleton/!Пакетная обработка.xlsm differ diff --git a/src/processor/AProcessor.cls b/src/processor/AProcessor.cls new file mode 100644 index 0000000..e180ec9 --- /dev/null +++ b/src/processor/AProcessor.cls @@ -0,0 +1,12 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "AProcessor" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Public Function ProcessSource(iSource As IteratorSource): End Function diff --git a/src/processor/DB_Sources.cls b/src/processor/DB_Sources.cls new file mode 100644 index 0000000..ffeb010 --- /dev/null +++ b/src/processor/DB_Sources.cls @@ -0,0 +1,109 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "DB_Sources" +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 Data() As Excel.Worksheet + Set Data = data_ +End Property + +Public Property Get TargetFolder() As String + TargetFolder = ThisWorkbook.Names(CELL_FOLDER).RefersToRange +End Property + +Public Property Get FileMask() As String + FileMask = ThisWorkbook.Names(CELL_MASK).RefersToRange +End Property + +Public Property Let TargetFolder(newVal$) + ThisWorkbook.Names(CELL_FOLDER).RefersToRange = newVal +End Property + +Public Property Let FileMask(newVal$) + ThisWorkbook.Names(CELL_MASK).RefersToRange = newVal +End Property + +Public Function IBegin() As IteratorSource + Set IBegin = New IteratorSource + Call IBegin.Init(data_) +End Function + +Public Function ILast() As IteratorSource + Set ILast = New IteratorSource + Call ILast.Init(data_) + Call ILast.GoLast +End Function + +Public Function Count() As Long + Count = ILast.row_ - IBegin.row_ + 1 +End Function + +Public Function INew() As IteratorSource + Set INew = New IteratorSource + 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 ClearCounters() + Dim sHeader$: sHeader = data_.Cells(1, S_SRC_COUNTER) + Call data_.Columns.Item(S_SRC_COUNTER).ClearContents + data_.Cells(1, S_SRC_COUNTER) = sHeader +End Function + +Public Function LoadSourcesFrom(sFolder$, sMask$) As Long + Dim iFiles As Collection: Set iFiles = ListFilesIn(sFolder, sMask) + LoadSourcesFrom = iFiles.Count + + Dim nID&: nID = Application.WorksheetFunction.Max(data_.Columns(S_SRC_ID)) + 1 + Dim iOut As IteratorSource: Set iOut = INew + Dim sFile As Variant + Dim fso As New Scripting.FileSystemObject + For Each sFile In iFiles + iOut.SourceID = nID + iOut.FileName = fso.GetFileName(CStr(sFile)) + iOut.Extension = fso.GetExtensionName(CStr(sFile)) + iOut.Path = sFile + nID = nID + 1 + Call iOut.Increment + Next sFile +End Function + +Public Function AcceptProcessor(iProcessor As AProcessor, Optional bShowProgress As Boolean = False) + If bShowProgress Then + Call CSE_ProgressBar.Init(" ", maxVal:=Count, canInterrupt:=True) + Call CSE_ProgressBar.ShowModeless + End If + + Dim iter As IteratorSource: Set iter = IBegin + Do While Not iter.IsDone + If bShowProgress Then + If CSE_ProgressBar.Interrupted Then _ + Exit Do + CSE_ProgressBar.Description = iter.FileName + End If + Call iProcessor.ProcessSource(iter) + Call iter.Increment + If bShowProgress Then _ + Call CSE_ProgressBar.IncrementA + Loop + + If bShowProgress Then _ + Call Unload(CSE_ProgressBar) +End Function diff --git a/src/processor/DB_Substitutes.cls b/src/processor/DB_Substitutes.cls new file mode 100644 index 0000000..c2fa81b --- /dev/null +++ b/src/processor/DB_Substitutes.cls @@ -0,0 +1,62 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "DB_Substitutes" +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 Function IBegin() As IteratorSubstitute + Set IBegin = New IteratorSubstitute + Call IBegin.Init(data_) +End Function + +Public Function ILast() As IteratorSubstitute + Set ILast = New IteratorSubstitute + Call ILast.Init(data_) + Call ILast.GoLast +End Function + +Public Function INew() As IteratorSubstitute + Set INew = New IteratorSubstitute + Call INew.Init(data_) + Call INew.GoLast + Call INew.Increment +End Function + +Public Function Count() As Long + Count = ILast.row_ - IBegin.row_ + 1 +End Function + +Public Function Clear() + Call data_.UsedRange.Offset(1).ClearContents +End Function + +Public Function ClearCounters() + Dim sHeader$: sHeader = data_.Cells(1, S_MATCH_COUNTER) + Call data_.Columns.Item(S_MATCH_COUNTER).ClearContents + data_.Cells(1, S_MATCH_COUNTER) = sHeader +End Function + +Public Function Processor() As ProcessorSubstitute + Dim opts As New OptionsSubstitutes + With opts + .caseSensitive_ = ThisWorkbook.Names(CELL_MATCHCASE).RefersToRange + .wholeWord_ = ThisWorkbook.Names(CELL_WHOLEWORD).RefersToRange + .regex_ = ThisWorkbook.Names(CELL_REGEX).RefersToRange + .mark_ = ThisWorkbook.Names(CELL_MARK_REPLACED).RefersToRange + End With + + Dim iProcessor As New ProcessorSubstitute + Call iProcessor.Init(opts, Me) + Set Processor = iProcessor +End Function diff --git a/src/processor/DataAccess.bas b/src/processor/DataAccess.bas new file mode 100644 index 0000000..a54558d --- /dev/null +++ b/src/processor/DataAccess.bas @@ -0,0 +1,25 @@ +Attribute VB_Name = "DataAccess" +Option Private Module +Option Explicit + +Public Function AccesSubstitutes() As DB_Substitutes + Static s_Substitutes As DB_Substitutes + + If s_Substitutes Is Nothing Then + Set s_Substitutes = New DB_Substitutes + Call s_Substitutes.Init(ThisWorkbook.Worksheets(SHEET_SUBSTITUTES)) + End If + + Set AccesSubstitutes = s_Substitutes +End Function + +Public Function AccessSources() As DB_Sources + Static s_Sources As DB_Sources + + If s_Sources Is Nothing Then + Set s_Sources = New DB_Sources + Call s_Sources.Init(ThisWorkbook.Worksheets(SHEET_SOURCES)) + End If + + Set AccessSources = s_Sources +End Function diff --git a/src/processor/Declarations.bas b/src/processor/Declarations.bas new file mode 100644 index 0000000..bd58afa --- /dev/null +++ b/src/processor/Declarations.bas @@ -0,0 +1,67 @@ +Attribute VB_Name = "Declarations" +Option Explicit + +Public Const FIRST_ROW = 2 + +Public Const SHEET_SOURCES = "" +Public Const SHEET_SUBSTITUTES = "" + +Public Const SHEET_ORDERS = "" +Public Const SHEET_EXCEPTIONS = "" +Public Const SHEET_COMMENTS = "" + +Public Const CELL_FOLDER = "c_Folder" +Public Const CELL_MASK = "c_Mask" + +Public Const CELL_MATCHCASE = "c_MatchCase" +Public Const CELL_WHOLEWORD = "c_WholeWord" +Public Const CELL_REGEX = "c_Regex" +Public Const CELL_MARK_REPLACED = "c_Mark" +Public Const CELL_DELETE_SOURCE = "c_DeleteSource" + +Public Const CELL_FILES = "c_FilesCount" + +Public Const TEMPLATES_PATH = "\\fs1.concept.ru\projects\10 \02 \00 \" +Public Const TEMPLATE_ORDERS = ".xltx" + +Public Enum SourcesStruct + [_First] = 1 + + S_SRC_ID = 1 + S_SRC_NAME = 2 + S_SRC_EXTENSION = 3 + S_SRC_PATH = 4 + S_SRC_COUNTER = 5 + + [_Last] = 5 +End Enum + +Public Enum MatchesStruct + [_First] = 1 + + S_MATCH_TARGET = 1 + S_MATCH_REPLACEMENT = 2 + S_MATCH_MORPHO = 3 + S_MATCH_COUNTER = 4 + + [_Last] = 4 +End Enum + +Public Enum OutputStruct + S_OUT_ID = 1 + S_OUT_SRC = 2 + S_OUT_PREFIX = 3 + S_OUT_TEXT = 4 + S_OUT_END = 5 +End Enum + +Public Enum CommentStruct + S_COM_ID = 1 + S_COM_SRC = 2 + S_COM_TEXT = 3 +End Enum + +Public Enum MiningFormat + MINE_UNDERLINE = 1 + MINE_HIGHLIGHT = 2 +End Enum diff --git a/src/processor/DevHelper.bas b/src/processor/DevHelper.bas new file mode 100644 index 0000000..ece8ab5 --- /dev/null +++ b/src/processor/DevHelper.bas @@ -0,0 +1,36 @@ +Attribute VB_Name = "DevHelper" +Option Private Module +Option Explicit + +Public Const TEST_TARGET_FOLDER = "testFiles" + +Public Function Dev_PrepareSkeleton() + ' Do nothing +End Function + +Public Function Dev_ManualRunTest() + Dim sSuite$: sSuite = "s_DBSources" + Dim sTest$: sTest = "t_Clear" + 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_DBSources": Set Dev_GetTestSuite = New s_DBSources + End Select +End Function + +Public Function TestFilesFolder() As String + Dim fso As New Scripting.FileSystemObject + TestFilesFolder = fso.GetParentFolderName(ThisWorkbook.Path) & "\" & TEST_TARGET_FOLDER +End Function + +Public Function SetupTestFolder() As String + Dim fso As New Scripting.FileSystemObject + Dim sFolder$: sFolder = fso.GetParentFolderName(ThisWorkbook.Path) & "\" & TEST_TARGET_FOLDER + If Not fso.FolderExists(sFolder) Then _ + Call fso.CreateFolder(sFolder) + SetupTestFolder = sFolder +End Function diff --git a/src/processor/IteratorSource.cls b/src/processor/IteratorSource.cls new file mode 100644 index 0000000..b456931 --- /dev/null +++ b/src/processor/IteratorSource.cls @@ -0,0 +1,86 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "IteratorSource" +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 IncrementCounter(Optional inc& = 1) + Counter = Counter + inc +End Function + +Public Function GoFirst() + row_ = FIRST_ROW +End Function + +Public Function GoLast() + row_ = data_.Columns(S_SRC_ID).Find(vbNullString, LookAt:=xlWhole).Row - 1 +End Function + +Public Function IsDone() As Boolean + IsDone = data_.Cells(row_, S_SRC_ID) = vbNullString +End Function + +Public Function RemoveRow() + Call data_.Rows(row_).Delete +End Function + +'===== Propertiy Get ===== +Public Property Get SourceID() As Long + SourceID = data_.Cells(row_, S_SRC_ID) +End Property + +Public Property Get FileName() As String + FileName = data_.Cells(row_, S_SRC_NAME) +End Property + +Public Property Get Extension() As String + Extension = data_.Cells(row_, S_SRC_EXTENSION) +End Property + +Public Property Get Path() As String + Path = data_.Cells(row_, S_SRC_PATH) +End Property + +Public Property Get Counter() As Long + Counter = data_.Cells(row_, S_SRC_COUNTER) +End Property + +' ==== Property Let ==== +Public Property Let SourceID(newVal&) + data_.Cells(row_, S_SRC_ID) = newVal +End Property + +Public Property Let FileName(newVal$) + data_.Cells(row_, S_SRC_NAME) = newVal +End Property + +Public Property Let Extension(newVal$) + data_.Cells(row_, S_SRC_EXTENSION) = newVal +End Property + +Public Property Let Path(newVal$) + data_.Cells(row_, S_SRC_PATH) = newVal + Call XLUpdateHyperlink(data_.Cells(row_, S_SRC_PATH), newVal) +End Property + +Public Property Let Counter(newVal&) + data_.Cells(row_, S_SRC_COUNTER) = newVal +End Property diff --git a/src/processor/IteratorSubstitute.cls b/src/processor/IteratorSubstitute.cls new file mode 100644 index 0000000..6bc4aea --- /dev/null +++ b/src/processor/IteratorSubstitute.cls @@ -0,0 +1,87 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "IteratorSubstitute" +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 IncrementCounter() + Counter = Counter + 1 +End Function + +Public Function GoFirst() + row_ = FIRST_ROW +End Function + +Public Function GoLast() + row_ = data_.Columns(S_MATCH_TARGET).Find(vbNullString, LookAt:=xlWhole).Row - 1 +End Function + +Public Function IsDone() As Boolean + IsDone = data_.Cells(row_, S_MATCH_TARGET) = vbNullString +End Function + +Public Function RemoveRow() + Call data_.Rows(row_).Delete +End Function + +'===== Propertiy Get ===== +Public Property Get FindWhat() As String + FindWhat = data_.Cells(row_, S_MATCH_TARGET) +End Property + +Public Property Get Replacement() As String + Replacement = data_.Cells(row_, S_MATCH_REPLACEMENT) +End Property + +Public Property Get UseMorpho() As Boolean + UseMorpho = data_.Cells(row_, S_MATCH_MORPHO) <> 0 +End Property + +Public Property Get Counter() As Long + Counter = data_.Cells(row_, S_MATCH_COUNTER) +End Property + +Public Property Get IsMultipleWords() As Boolean + IsMultipleWords = True + + Dim sData$: sData = FindWhat + Dim nChar& + For nChar = 1 To VBA.Len(sData) + Dim sChar$: sChar = VBA.Mid(sData, nChar, 1) + If Not IsAlphaNumeric(sChar) Then _ + Exit Function + Next nChar + + IsMultipleWords = False +End Property + +' ==== Property Let ==== +Public Property Let FindWhat(newVal$) + data_.Cells(row_, S_MATCH_TARGET) = newVal +End Property + +Public Property Let Replacement(newVal$) + data_.Cells(row_, S_MATCH_REPLACEMENT) = newVal +End Property + +Public Property Let Counter(newVal&) + data_.Cells(row_, S_MATCH_COUNTER) = newVal +End Property diff --git a/src/processor/Main.bas b/src/processor/Main.bas new file mode 100644 index 0000000..f94e3ce --- /dev/null +++ b/src/processor/Main.bas @@ -0,0 +1,162 @@ +Attribute VB_Name = "Main" +Option Explicit + +Public Sub RunAddSources() + Dim iData As DB_Sources: Set iData = AccessSources + If Not PromptFolderMask(iData) Then _ + Exit Sub + + Dim xlUI As New API_XLWrapper: Call xlUI.SetDocument(ThisWorkbook) + Call xlUI.PauseUI + Dim nCount&: nCount = iData.LoadSourcesFrom(iData.TargetFolder, iData.FileMask) + Call xlUI.ResumeUI + + Call iData.Data.Activate + Call UserInteraction.ShowMessage(IM_FILES_UPDATED, nCount) +End Sub + +Public Sub RunNewSources() + Dim iData As DB_Sources: Set iData = AccessSources + If Not PromptFolderMask(iData) Then _ + Exit Sub + + Dim xlUI As New API_XLWrapper: Call xlUI.SetDocument(ThisWorkbook) + Call xlUI.PauseUI + Call iData.Clear + Dim nCount&: nCount = iData.LoadSourcesFrom(iData.TargetFolder, iData.FileMask) + Call xlUI.ResumeUI + + Call iData.Data.Activate + Call UserInteraction.ShowMessage(IM_FILES_UPDATED, nCount) +End Sub + +Public Sub RunClearSources() + Call AccessSources.Clear + Call UserInteraction.ShowMessage(IM_FILES_CLEARED) +End Sub + +Public Sub RunConvertToDocx() + Dim iData As DB_Sources: Set iData = AccessSources + Dim iProcessor As New ProcessorSaveAs: Call iProcessor.Init("docx", bDeleteSource:=True) + Call iData.ClearCounters + Call iData.AcceptProcessor(iProcessor, bShowProgress:=True) + Call iProcessor.Finalize + + Call UserInteraction.ShowMessage(IM_CONVERT_EXTENSION, iProcessor.countProcessed_, iProcessor.countAll_) +End Sub + +Public Sub RunMasterDocument() + Dim iData As DB_Sources: Set iData = AccessSources + Dim iProcessor As New ProcessorMasterDoc: Call iProcessor.Init + Call iData.ClearCounters + Call iData.AcceptProcessor(iProcessor, bShowProgress:=True) + Call iProcessor.Finalize + + Call iProcessor.word_.Document.ActiveWindow.Activate + Call UserInteraction.ShowMessage(IM_MASTERDOC, iProcessor.countProcessed_, iProcessor.countAll_) +End Sub + +Public Sub RunSaveAs() + Dim sExtension$: sExtension = UserInteraction.PromptInput(" ", " ", sInitial:="pdf") + If sExtension = vbNullString Then _ + Exit Sub + Dim bDeleteSource As Boolean: bDeleteSource = ThisWorkbook.Names(CELL_DELETE_SOURCE).RefersToRange = 1 + Dim iData As DB_Sources: Set iData = AccessSources + Dim iProcessor As New ProcessorSaveAs: Call iProcessor.Init(sExtension, bDeleteSource) + Call iData.AcceptProcessor(iProcessor, bShowProgress:=True) + Call iProcessor.Finalize + + Call UserInteraction.ShowMessage(IM_CONVERT_EXTENSION, iProcessor.countProcessed_, iProcessor.countAll_) +End Sub + +Public Sub RunMarkSubstitutes() + Dim iData As DB_Sources: Set iData = AccessSources + Dim iSubstitutes As DB_Substitutes: Set iSubstitutes = AccesSubstitutes + Dim iProcessor As ProcessorSubstitute: Set iProcessor = iSubstitutes.Processor + iProcessor.GetOptions.doReplace_ = False + iProcessor.GetOptions.mark_ = True + + Call iData.ClearCounters + Call iSubstitutes.ClearCounters + Call iData.AcceptProcessor(iProcessor, bShowProgress:=True) + Call iProcessor.Finalize + + Call UserInteraction.ShowMessage(IM_SUBSTITUTES_MARKED) +End Sub + +Public Sub RunExecuteSubstitutes() + Call AccessPython.StartServer + If Not AccessPython.Validate Then _ + Call UserInteraction.ShowMessage(EM_NO_PYTHON) + + Dim iData As DB_Sources: Set iData = AccessSources + Dim iSubstitutes As DB_Substitutes: Set iSubstitutes = AccesSubstitutes + Dim iProcessor As ProcessorSubstitute: Set iProcessor = iSubstitutes.Processor + iProcessor.GetOptions.doReplace_ = True + + Call iData.ClearCounters + Call iSubstitutes.ClearCounters + Call iData.AcceptProcessor(iProcessor, bShowProgress:=True) + Call iProcessor.Finalize + + Call UserInteraction.ShowMessage(IM_SUBSTITUTES_DONE) +End Sub + +Public Sub RunMineOrders() + Dim iOutput As Excel.Workbook: Set iOutput = PrepareOrdersOutput() + If iOutput Is Nothing Then _ + Exit Sub + + Dim iData As DB_Sources: Set iData = AccessSources + Dim iProcessor As New ProcessorOrders: Call iProcessor.Init(iOutput) + + Dim theTimer As New API_Timer: Call theTimer.Start + Dim xlUI As New API_XLWrapper: Call xlUI.SetDocument(iOutput) + Call xlUI.PauseUI + + Call iData.AcceptProcessor(iProcessor) + Call xlUI.ResumeUI + Call iProcessor.Finalize + Call iOutput.Activate + Call UserInteraction.ShowMessage(IM_ORDERS_PROCESSED, theTimer.TimeStr) +End Sub + +Public Sub RunExtractUnderlined() + Dim iOutput As Excel.Workbook: Set iOutput = PrepareFormatOutput() + If iOutput Is Nothing Then _ + Exit Sub + + Dim iData As DB_Sources: Set iData = AccessSources + Dim iProcessor As New ProcessorFormatMine: Call iProcessor.Init(iOutput.Sheets(1), MINE_UNDERLINE) + + Dim theTimer As New API_Timer: Call theTimer.Start + Dim xlUI As New API_XLWrapper: Call xlUI.SetDocument(iOutput) + Call xlUI.PauseUI + + Call iData.AcceptProcessor(iProcessor) + + Call xlUI.ResumeUI + Call iProcessor.Finalize + Call iOutput.Activate + Call UserInteraction.ShowMessage(IM_EXTRACT_SUCCESS, theTimer.TimeStr) +End Sub + +Public Sub RunExtractColored() + Dim iOutput As Excel.Workbook: Set iOutput = PrepareFormatOutput() + If iOutput Is Nothing Then _ + Exit Sub + + Dim iData As DB_Sources: Set iData = AccessSources + Dim iProcessor As New ProcessorFormatMine: Call iProcessor.Init(iOutput.Sheets(1), MINE_HIGHLIGHT) + + Dim theTimer As New API_Timer: Call theTimer.Start + Dim xlUI As New API_XLWrapper: Call xlUI.SetDocument(iOutput) + Call xlUI.PauseUI + + Call iData.AcceptProcessor(iProcessor) + + Call xlUI.ResumeUI + Call iProcessor.Finalize + Call iOutput.Activate + Call UserInteraction.ShowMessage(IM_EXTRACT_SUCCESS, theTimer.TimeStr) +End Sub diff --git a/src/processor/MainImpl.bas b/src/processor/MainImpl.bas new file mode 100644 index 0000000..07a6672 --- /dev/null +++ b/src/processor/MainImpl.bas @@ -0,0 +1,36 @@ +Attribute VB_Name = "MainImpl" +Option Private Module +Option Explicit + +Public Function ClearAll() + Call AccessSources.Clear + Call AccesSubstitutes.Clear +End Function + +Public Function PromptFolderMask(iData As DB_Sources) As Boolean + PromptFolderMask = False + + Dim sMask$: sMask = UserInteraction.PromptInput(" ", " ", sInitial:=iData.FileMask) + If sMask = vbNullString Then _ + Exit Function + Dim sFolder$: sFolder = UserInteraction.PromptFolder(iData.TargetFolder & "\") + If sFolder = vbNullString Then _ + Exit Function + + iData.TargetFolder = sFolder + iData.FileMask = sMask + + PromptFolderMask = True +End Function + +Public Function PrepareOrdersOutput() As Excel.Workbook + Dim iExcel As New API_XLWrapper: Call iExcel.SetApplication(ThisWorkbook.Application) + Set PrepareOrdersOutput = iExcel.NewDocument(sTemplate:=TEMPLATES_PATH & "\" & TEMPLATE_ORDERS, bDefaultIfFail:=False) +End Function + +Public Function PrepareFormatOutput() As Excel.Workbook + Dim iExcel As New API_XLWrapper: Call iExcel.SetApplication(ThisWorkbook.Application) + Set PrepareFormatOutput = iExcel.NewDocument() + iExcel.Document.Sheets(1).Cells(1, 1) = "File" + iExcel.Document.Sheets(1).Cells(1, 2) = "Data" +End Function diff --git a/src/processor/OptionsSubstitutes.cls b/src/processor/OptionsSubstitutes.cls new file mode 100644 index 0000000..4eea4ef --- /dev/null +++ b/src/processor/OptionsSubstitutes.cls @@ -0,0 +1,16 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "OptionsSubstitutes" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Public caseSensitive_ As Boolean +Public wholeWord_ As Boolean +Public regex_ As Boolean +Public mark_ As Boolean +Public doReplace_ As Boolean diff --git a/src/processor/ProcessorFormatMine.cls b/src/processor/ProcessorFormatMine.cls new file mode 100644 index 0000000..4d8b65a --- /dev/null +++ b/src/processor/ProcessorFormatMine.cls @@ -0,0 +1,82 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "ProcessorFormatMine" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Implements AProcessor + +Private word_ As API_WordWrapper +Private doc_ As Word.Document + +Private out_ As Excel.Worksheet +Private row_ As Long +Private format_ As MiningFormat + +Public Function Init(iOut As Excel.Worksheet, iFormat As MiningFormat) + Set word_ = New API_WordWrapper: Call word_.CreateApplication + Set out_ = iOut + row_ = FIRST_ROW + format_ = iFormat +End Function + +Public Function Finalize() + Call word_.ReleaseApplication +End Function + +Public Function AProcessor_ProcessSource(iSource As IteratorSource) + If ApplicationFromExtension(iSource.Extension) <> T_APP_WORD Then _ + Exit Function + + Set doc_ = word_.OpenDocument(iSource.Path, bReadOnly:=True) + If doc_ Is Nothing Then _ + Exit Function + + Dim iData As Collection: Set iData = FindAllIn(doc_.Range) + Dim sText As Variant + For Each sText In iData + out_.Cells(row_, 1) = iSource.Path + out_.Cells(row_, 2) = CStr(sText) + row_ = row_ + 1 + Next sText + + Call word_.ReleaseDocument(bCloseApplication:=False) +End Function + +' ====== +Private Function FindAllIn(target As Word.Range) As Collection + Dim iFound As Collection: Set iFound = New Collection + + Call SetupFindParams(target) + Do While target.Find.Execute + Call iFound.Add(TrimWhitespace(target.Text)) + Call target.Collapse(wdCollapseEnd) + Loop + + Set FindAllIn = iFound +End Function + +Private Function SetupFindParams(target As Word.Range) + Call target.Find.ClearFormatting + Select Case format_ + Case MiningFormat.MINE_HIGHLIGHT + With target.Find + .Text = "" + .Format = True + .Highlight = True + End With + + Case MiningFormat.MINE_UNDERLINE + With target.Find + .Text = "" + .Format = True + .Font.Underline = wdUnderlineSingle + End With + End Select +End Function + diff --git a/src/processor/ProcessorMasterDoc.cls b/src/processor/ProcessorMasterDoc.cls new file mode 100644 index 0000000..9e4eaf9 --- /dev/null +++ b/src/processor/ProcessorMasterDoc.cls @@ -0,0 +1,44 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "ProcessorMasterDoc" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Implements AProcessor + +Public word_ As API_WordWrapper + +Public countProcessed_ As Long +Public countAll_ As Long + +Public Function Init() + countProcessed_ = 0 + countAll_ = 0 + + Set word_ = New API_WordWrapper: Call word_.CreateApplication + Call word_.NewDocument + word_.Document.ActiveWindow.ActivePane.View.Type = wdOutlineView + word_.Document.ActiveWindow.View = wdMasterView +End Function + +Public Function Finalize() + +End Function + +Public Function AProcessor_ProcessSource(iSource As IteratorSource) + countAll_ = countAll_ + 1 + + On Error GoTo FAILED_TO_ADD + Call word_.Document.Subdocuments.AddFromFile(iSource.Path, ConfirmConversions:=True, ReadOnly:=False, Revert:=False) + On Error GoTo 0 + + countProcessed_ = countProcessed_ + 1 + + Exit Function +FAILED_TO_ADD: +End Function diff --git a/src/processor/ProcessorOrders.cls b/src/processor/ProcessorOrders.cls new file mode 100644 index 0000000..230a50a --- /dev/null +++ b/src/processor/ProcessorOrders.cls @@ -0,0 +1,213 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "ProcessorOrders" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Implements AProcessor + +Private word_ As API_WordWrapper +Private doc_ As Word.Document + +Private sourceOut_ As IteratorSource + +Private orders_ As Excel.Worksheet +Private exceptions_ As Excel.Worksheet +Private comments_ As Excel.Worksheet + +Private rowOrder_ As Long +Private rowException_ As Long +Private rowComment_ As Long + +Public countOrders_ As Long +Public countExceptions_ As Long +Public countComments_ As Long + +Public Function Init(iOut As Excel.Workbook) + Set word_ = New API_WordWrapper: Call word_.CreateApplication + + Set orders_ = iOut.Sheets(SHEET_ORDERS) + Set exceptions_ = iOut.Sheets(SHEET_EXCEPTIONS) + Set comments_ = iOut.Sheets(SHEET_COMMENTS) + + Set sourceOut_ = New IteratorSource: Call sourceOut_.Init(iOut.Sheets(SHEET_SOURCES)) + + countOrders_ = 0 + countExceptions_ = 0 + countComments_ = 0 + + rowOrder_ = FIRST_ROW + rowException_ = FIRST_ROW + rowComment_ = FIRST_ROW +End Function + +Public Function Finalize() + Call word_.ReleaseApplication +End Function + +Public Function AProcessor_ProcessSource(iSource As IteratorSource) + If ApplicationFromExtension(iSource.Extension) <> T_APP_WORD Then _ + Exit Function + + Set doc_ = word_.OpenDocument(iSource.Path, bReadOnly:=True) + If doc_ Is Nothing Then _ + Exit Function + + Dim iOrdersRange As Word.Range: Set iOrdersRange = FindOrders() + If iOrdersRange Is Nothing Then _ + Exit Function + + Dim nSource&: nSource = iSource.SourceID + Dim nCount&: nCount = 0 + + Dim aPar As Word.Paragraph + For Each aPar In iOrdersRange.Paragraphs + Dim target As Word.Range: Set target = aPar.Range + Dim sText$: sText = SubstituteWhitespace(target.Text) + If IsComment(target) Then + Call AddComment(nSource, sText) + ElseIf IsValidOrder(sText) Then + Call ProcessOrder(sText, nSource) + nCount = nCount + 1 + Else + Call ProcessException(sText, nSource) + End If + Next aPar + + Call word_.ReleaseDocument(bCloseApplication:=False) + Call OutputSource(iSource, nCount) +End Function + +' ==== +Private Function FindOrders() As Word.Range + Dim iFind As Word.Range: Set iFind = doc_.Range + With iFind.Find + .Style = doc_.Styles(wdStyleHeading1) + .Wrap = wdFindStop + End With + + Dim nStart&: nStart = 0 + Do While iFind.Find.Execute + If iFind.Text Like "*[]*" Then + nStart = iFind.End + Call iFind.Collapse(wdCollapseEnd) + Exit Do + End If + Call iFind.Collapse(wdCollapseEnd) + Loop + If nStart = 0 Then _ + Exit Function + If Not iFind.Find.Execute Then _ + Exit Function + + Dim nEnd&: nEnd = iFind.Start + iFind.Start = nStart + iFind.End = nEnd + + Set FindOrders = iFind +End Function + +Private Function IsComment(target As Word.Range) As Boolean + IsComment = True + + Dim sStyle$: sStyle = target.Style + If sStyle Like "*[]*" Then _ + Exit Function + If sStyle Like "*[] *" Then _ + Exit Function + + IsComment = False +End Function + +Private Function IsValidOrder(sText$) As Boolean + IsValidOrder = False + If sText Like "*[] *" Then _ + Exit Function + If sText Like "*[] *" Then _ + Exit Function + If sText Like "*[][][.;:]" Then _ + Exit Function + If sText Like "*[][][.;:]" Then _ + Exit Function + IsValidOrder = True +End Function + +Private Function ProcessOrder(sText$, nSource&) As Boolean + Dim sPrefix$: sPrefix = ExtractPrefix(sText) + If sPrefix <> vbNullString Then _ + sText = VBA.Trim(VBA.Right(sText, VBA.Len(sText) - VBA.Len(sPrefix) - 1)) + + Dim bIsFinish As Boolean: bIsFinish = Not sText Like "*:" + Call AddOrder(nSource, sPrefix, sText, bIsFinish) +End Function + +Private Function ProcessException(sText$, nSource&) + Dim sPrefix$: sPrefix = ExtractPrefix(sText) + If sPrefix <> vbNullString Then _ + sText = VBA.Trim(VBA.Right(sText, VBA.Len(sText) - VBA.Len(sPrefix) - 1)) + + Dim bIsFinish As Boolean: bIsFinish = Not sText Like "*:" + Call AddException(nSource, sPrefix, sText, bIsFinish) +End Function + +Private Function ExtractPrefix(sText$) As String + Dim nPrefix&: nPrefix = 0 + Do While VBA.Mid(sText, nPrefix + 1, 1) Like "[ ().0123456789-]" + nPrefix = nPrefix + 1 + Loop + If nPrefix = 0 Then _ + Exit Function + + ExtractPrefix = VBA.Trim(VBA.Left(sText, nPrefix)) +End Function + +Private Function AddOrder(nSrc&, sPrefix$, sText$, bIsFinish As Boolean) + countOrders_ = countOrders_ + 1 + + orders_.Cells(rowOrder_, S_OUT_ID) = countOrders_ + orders_.Cells(rowOrder_, S_OUT_SRC) = nSrc + orders_.Cells(rowOrder_, S_OUT_PREFIX) = sPrefix + orders_.Cells(rowOrder_, S_OUT_TEXT) = sText + orders_.Cells(rowOrder_, S_OUT_END) = IIf(bIsFinish, 1, 0) + + rowOrder_ = rowOrder_ + 1 +End Function + +Private Function AddException(nSrc&, sPrefix$, sText$, bIsFinish As Boolean) + countExceptions_ = countExceptions_ + 1 + + exceptions_.Cells(rowException_, S_OUT_ID) = countExceptions_ + exceptions_.Cells(rowException_, S_OUT_SRC) = nSrc + exceptions_.Cells(rowException_, S_OUT_PREFIX) = sPrefix + exceptions_.Cells(rowException_, S_OUT_TEXT) = sText + exceptions_.Cells(rowException_, S_OUT_END) = IIf(bIsFinish, 1, 0) + + rowException_ = rowException_ + 1 +End Function + +Private Function AddComment(nSrc&, sText$) + countComments_ = countComments_ + 1 + + comments_.Cells(rowComment_, S_COM_ID) = countComments_ + comments_.Cells(rowComment_, S_COM_SRC) = nSrc + comments_.Cells(rowComment_, S_COM_TEXT) = sText + + rowComment_ = rowComment_ + 1 +End Function + +Private Function OutputSource(iSource As IteratorSource, nCount&) + With sourceOut_ + .Counter = nCount + .FileName = iSource.FileName + .Extension = iSource.Extension + .Path = iSource.Path + .SourceID = iSource.SourceID + + Call .Increment + End With +End Function diff --git a/src/processor/ProcessorSaveAs.cls b/src/processor/ProcessorSaveAs.cls new file mode 100644 index 0000000..4bb0762 --- /dev/null +++ b/src/processor/ProcessorSaveAs.cls @@ -0,0 +1,106 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "ProcessorSaveAs" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Implements AProcessor + +Private targetExtension_ As String +Private deleteSource_ As Boolean + +Private fso_ As Scripting.FileSystemObject +Private word_ As API_WordWrapper +Private xl_ As API_XLWrapper +Private vso_ As API_VsoWrapper + +Public countProcessed_ As Long +Public countAll_ As Long + +Public Function Init(sExtension$, bDeleteSource As Boolean) + Set fso_ = New Scripting.FileSystemObject + countProcessed_ = 0 + countAll_ = 0 + targetExtension_ = sExtension + deleteSource_ = bDeleteSource +End Function + +Public Function Finalize() + If Not word_ Is Nothing Then _ + Call word_.ReleaseApplication + If Not xl_ Is Nothing Then _ + Call xl_.ReleaseApplication + If Not vso_ Is Nothing Then _ + Call vso_.ReleaseApplication +End Function + +Public Function AProcessor_ProcessSource(iSource As IteratorSource) + Dim sExt$: sExt = VBA.UCase(iSource.Extension) + If sExt = VBA.UCase(targetExtension_) Then + countAll_ = countAll_ + 1 + iSource.Counter = 0 + Exit Function + End If + + Dim iWrapper As Object: Set iWrapper = GetWrapper(ApplicationFromExtension(sExt)) + If iWrapper Is Nothing Then _ + Exit Function + + countAll_ = countAll_ + 1 + iSource.Counter = -1 + + Dim sOldPath$: sOldPath = iSource.Path + If iWrapper.OpenDocument(sOldPath, bReadOnly:=False) Is Nothing Then _ + Exit Function + + Dim sNewPath$: sNewPath = fso_.GetParentFolderName(sOldPath) & "\" & fso_.GetBaseName(sOldPath) & "." & targetExtension_ + If fso_.FileExists(sNewPath) Then _ + GoTo SAFE_EXIT + If Not iWrapper.SaveAs(sNewPath) Then _ + GoTo SAFE_EXIT + + countProcessed_ = countProcessed_ + 1 + iSource.Counter = 1 + iSource.FileName = fso_.GetFileName(sNewPath) + iSource.Extension = "docx" + iSource.Path = sNewPath + + Call word_.ReleaseDocument(bCloseApplication:=False) + If deleteSource_ Then _ + Call fso_.DeleteFile(sOldPath) + Exit Function + +SAFE_EXIT: + Call word_.ReleaseDocument(bCloseApplication:=False) +End Function + +' ====== +Private Function GetWrapper(nAppl As TApplication) As Object + Select Case nAppl + Case T_APP_WORD + If word_ Is Nothing Then + Set word_ = New API_WordWrapper + Call word_.CreateApplication + End If + Set GetWrapper = word_ + + Case T_APP_EXCEL + If xl_ Is Nothing Then + Set xl_ = New API_XLWrapper + Call xl_.CreateApplication + End If + Set GetWrapper = xl_ + + Case T_APP_VISIO + If vso_ Is Nothing Then + Set vso_ = New API_VsoWrapper + Call vso_.CreateApplication + End If + Set GetWrapper = vso_ + End Select +End Function diff --git a/src/processor/ProcessorSubstitute.cls b/src/processor/ProcessorSubstitute.cls new file mode 100644 index 0000000..4530a3a --- /dev/null +++ b/src/processor/ProcessorSubstitute.cls @@ -0,0 +1,219 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "ProcessorSubstitute" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Implements AProcessor + +Private substitutes_ As DB_Substitutes +Private options_ As OptionsSubstitutes + +Private word_ As API_WordWrapper +Private visio_ As API_VsoWrapper +Private hasPython_ As Boolean + +Public Function Init(iOptions As OptionsSubstitutes, iSubstitutes As DB_Substitutes) + Set options_ = iOptions + Set substitutes_ = iSubstitutes + hasPython_ = AccessPython.Validate +End Function + +Public Function Finalize() + If Not word_ Is Nothing Then _ + Call word_.ReleaseApplication + If Not visio_ Is Nothing Then _ + Call visio_.ReleaseApplication +End Function + +Public Function GetOptions() As OptionsSubstitutes + Set GetOptions = options_ +End Function + +Public Function AProcessor_ProcessSource(iSource As IteratorSource) + Dim iAppl As TApplication: iAppl = ApplicationFromExtension(iSource.Extension) + If iAppl = T_APP_VISIO Then + Call ProcessVisio(iSource) + ElseIf iAppl = T_APP_WORD Then + Call ProcessWord(iSource) + End If +End Function + +' ====== +Private Function AccessWord() As API_WordWrapper + If word_ Is Nothing Then + Set word_ = New API_WordWrapper + Call word_.CreateApplication + End If + Set AccessWord = word_ +End Function + +Private Function AccessVisio() As API_VsoWrapper + If visio_ Is Nothing Then + Set visio_ = New API_VsoWrapper + Call visio_.CreateApplication + End If + Set AccessVisio = visio_ +End Function + +Private Function ProcessVisio(iSource As IteratorSource) + Dim iDoc As Visio.Document: Set iDoc = AccessVisio.OpenDocument(iSource.Path) + If iDoc Is Nothing Then _ + Exit Function + Dim iShape As Visio.Shape + Dim iPage As Visio.Page + For Each iPage In iDoc.Pages + For Each iShape In iPage.Shapes + If iShape.Type = visTypeShape Then _ + Call iSource.IncrementCounter(ProcessShapeText(iShape)) + Next iShape + Next iPage + + Call AccessVisio.ReleaseDocument(bCloseApplication:=False, bSaveChanges:=True) +End Function + +Private Function ProcessShapeText(target As Visio.Shape) As Long + Dim shpText$: shpText = VBA.Trim(target.Text) + If shpText = vbNullString Then _ + Exit Function + + Dim iter As IteratorSubstitute: Set iter = substitutes_.IBegin + Do While Not iter.IsDone + Dim sNeedle$: sNeedle = iter.FindWhat + If Not RegexTest(shpText, sNeedle) Then _ + GoTo NEXT_TEST + + ProcessShapeText = ProcessShapeText + 1 + Call iter.IncrementCounter + If options_.doReplace_ Then _ + target.Text = RegexReplace(shpText, sNeedle, iter.Replacement, 1) + If options_.mark_ Then _ + target.Characters.CharProps(visCharacterStyle) = visItalic + +NEXT_TEST: + Call iter.Increment + Loop +End Function + +Private Function ProcessWord(iSource As IteratorSource) + Dim iDoc As Word.Document: Set iDoc = AccessWord.OpenDocument(iSource.Path, bReadOnly:=False) + If iDoc Is Nothing Then _ + Exit Function + + If CSE_ProgressBar.Visible Then _ + Call CSE_ProgressBar.InitSecondBar(maxVal:=substitutes_.Count) + + Dim bNeedSpaces As Boolean + Dim iter As IteratorSubstitute: Set iter = substitutes_.IBegin + Do While Not iter.IsDone + Dim rFind As Word.Range: Set rFind = iDoc.Range + bNeedSpaces = iter.IsMultipleWords And options_.wholeWord_ + + If CSE_ProgressBar.Visible Then _ + If CSE_ProgressBar.Interrupted Then _ + Exit Do + + With rFind.Find + .Text = IIf(bNeedSpaces, PrepareSearchText(iter.FindWhat), iter.FindWhat) + .MatchCase = options_.caseSensitive_ + .MatchWholeWord = options_.wholeWord_ + .MatchWildcards = options_.regex_ Or bNeedSpaces + End With + + Do While rFind.Find.Execute + If bNeedSpaces Then + rFind.Start = rFind.Start + 1 + rFind.End = rFind.End - 1 + End If + + If options_.doReplace_ Then _ + Call ReplaceTextInRange(rFind, iter.Replacement, iter.UseMorpho) + + Call iSource.IncrementCounter + Call iter.IncrementCounter + + If options_.mark_ Then _ + rFind.HighlightColorIndex = IIf(options_.doReplace_, wdGray25, wdGray50) + Call rFind.Collapse(wdCollapseEnd) + Loop + + If CSE_ProgressBar.Visible Then _ + Call CSE_ProgressBar.IncrementB + Call iter.Increment + Loop + + If CSE_ProgressBar.Visible Then _ + Call CSE_ProgressBar.HideSecondBar + + Call AccessWord.ReleaseDocument(bCloseApplication:=False, bSaveChanges:=True) +End Function + +Private Function PrepareSearchText(sQuery$) As String + Dim sFirstSymbol$: sFirstSymbol = VBA.Left$(sQuery, 1) + If sFirstSymbol <> "[" Then + PrepareSearchText = "[" & VBA.UCase(sFirstSymbol) & VBA.LCase(sFirstSymbol) & "]" & VBA.Right(sQuery, VBA.Len(sQuery) - 1) + Else + PrepareSearchText = sQuery + End If + PrepareSearchText = "[ ^0013^0009\-]" & PrepareSearchText & "[ ^0013^0009.,\!\?\-\)]" +End Function + +Private Function ReplaceTextInRange(target As Word.Range, sReplacement$, bMorpho As Boolean) + If bMorpho And hasPython_ Then + Dim sNextWord$, sPrevWord$ + If target.Next(wdCharacter, 1) = " " Then + Dim nextWordRange As Word.Range: Set nextWordRange = target.Duplicate + Call nextWordRange.Collapse(wdCollapseEnd) + Set nextWordRange = nextWordRange.Next(wdWord, 1) + sNextWord = VBA.Trim(nextWordRange.Text) + If Not IsAlphaNumeric(sNextWord) Then sNextWord = "" + End If + + If target.Previous(wdCharacter, 1) = " " Then + Dim prevWordRange As Word.Range: Set prevWordRange = target.Duplicate + Call prevWordRange.Collapse(wdCollapseStart) + Set prevWordRange = prevWordRange.Previous(wdWord, 1) + sPrevWord = VBA.Trim(prevWordRange.Text) + If Not IsAlphaNumeric(sPrevWord) Then sPrevWord = "" + End If + + sReplacement = ApplyMorpho(sReplacement, sPrevWord, sNextWord) + End If + + Dim sFirstSymbol$: sFirstSymbol = VBA.Left$(target.Text, 1) + If sFirstSymbol Like "[-A-Z]" Then + target.Text = CapitalizeFirstLetter(sReplacement) + Else + target.Text = sReplacement + End If +End Function + +Private Function ApplyMorpho(sTarget$, sPrev$, sNext$) As String + Dim sInflected$: sInflected = AccessPython.CallFunction(PY_MODULE_TEXT, "inflect_context", Array(sTarget, sPrev, sNext)) + If sInflected = "" Or sInflected Like "*error*" Then _ + sInflected = sTarget + + ApplyMorpho = sInflected +End Function + +Private Function ExtractAdjectiveForm(sParse$) As String + Dim sResult$ + If VBA.InStr(1, sParse, "plur") <> 0 Then + sResult = "plur" + Else + If VBA.InStr(1, sParse, "femn") <> 0 Then + sResult = "femn,sing" + ElseIf VBA.InStr(1, sParse, "masc") <> 0 Then + sResult = "masc,sing" + Else + sResult = "neut,sing" + End If + End If + sResult = sResult & "," & VBA.Right(sParse, VBA.Len(sParse) - VBA.InStrRev(sParse, ",")) + ExtractAdjectiveForm = sResult +End Function diff --git a/src/processor/z_UIMessages.bas b/src/processor/z_UIMessages.bas new file mode 100644 index 0000000..c81c457 --- /dev/null +++ b/src/processor/z_UIMessages.bas @@ -0,0 +1,67 @@ +Attribute VB_Name = "z_UIMessages" +' Messaging module +Option Private Module +Option Explicit + +Public Enum MsgCode + MSG_OK = 0 + + IM_FILES_CLEARED + IM_FILES_UPDATED + IM_SUBSTITUTES_MARKED + IM_SUBSTITUTES_DONE + IM_ORDERS_PROCESSED + IM_CONVERT_EXTENSION + IM_MASTERDOC + IM_EXTRACT_SUCCESS + + EM_NO_PYTHON + + ' 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 IM_FILES_CLEARED: Call MsgBox(" ", vbInformation) + Case IM_FILES_UPDATED: Call MsgBox(Fmt(" : {1} ", unwrapped), vbInformation) + Case IM_SUBSTITUTES_MARKED: Call MsgBox(" ", vbInformation) + Case IM_SUBSTITUTES_DONE: Call MsgBox(" ", vbInformation) + Case IM_ORDERS_PROCESSED: Call MsgBox(Fmt(" {1}", unwrapped), vbInformation) + Case IM_CONVERT_EXTENSION: Call MsgBox(Fmt(" : {1}/{2}", unwrapped), vbInformation) + Case IM_MASTERDOC: Call MsgBox(Fmt(" : {1}/{2}", unwrapped), vbInformation) + Case IM_EXTRACT_SUCCESS: Call MsgBox(Fmt(" {1}", unwrapped), vbInformation) + + Case EM_NO_PYTHON: Call MsgBox(" . ", vbExclamation) + + 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/processor/z_UIRibbon.bas b/src/processor/z_UIRibbon.bas new file mode 100644 index 0000000..d4a3f96 --- /dev/null +++ b/src/processor/z_UIRibbon.bas @@ -0,0 +1,23 @@ +Attribute VB_Name = "z_UIRibbon" +Option Explicit +Option Private Module + +Public Sub OnRibbonBtn(iControl As IRibbonControl) + Select Case iControl.ID + + Case "AddSources": Call RunAddSources + Case "NewSources": Call RunNewSources + Case "ClearSources": Call RunClearSources + Case "ConvertToDocx": Call RunConvertToDocx + Case "MasterDocument": Call RunMasterDocument + Case "SaveAs": Call RunSaveAs + + Case "MarkSubstitutes": Call RunMarkSubstitutes + Case "ExecuteSubstitutes": Call RunExecuteSubstitutes + + Case "MineOrders": Call RunMineOrders + Case "ExtractUnderlined": Call RunExtractUnderlined + Case "ExtractColored": Call RunExtractColored + + End Select +End Sub diff --git a/src/test/s_DBSources.cls b/src/test/s_DBSources.cls new file mode 100644 index 0000000..c6e75e3 --- /dev/null +++ b/src/test/s_DBSources.cls @@ -0,0 +1,53 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "s_DBSources" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +' TODO: +' Public Function LoadSourcesFrom(sFolder$, sMask$) As Long + +Private db_ As DB_Sources +Private fso_ As Scripting.FileSystemObject +Private folder_ As String + +Public Function Setup() + ' Mandatory setup function + Set db_ = AccessSources + Set fso_ = New Scripting.FileSystemObject + folder_ = SetupTestFolder +End Function + +Public Function Teardown() + ' Mandatory teardown function + Call db_.Clear + Call fso_.DeleteFolder(TestFilesFolder) +End Function + +Public Function t_Clear() + On Error GoTo PROPAGATE_ERROR + + Dim iter As IteratorSource: Set iter = db_.INew + iter.Counter = 1 + iter.FileName = "test.txt" + Call Dev_ExpectEQ(1, iter.Counter) + Call Dev_ExpectEQ("test.txt", iter.FileName) + + Call Dev_NewCase("ClearCounters") + Call db_.ClearCounters + Call Dev_ExpectEQ(0, iter.Counter) + Call Dev_ExpectEQ("test.txt", iter.FileName) + + Call Dev_NewCase("ClearAll") + Call db_.Clear + Call Dev_ExpectEQ("", iter.FileName) + + Exit Function +PROPAGATE_ERROR: + Call Dev_LogError(Err.Number, Err.Description) +End Function diff --git a/ui/processor/.rels b/ui/processor/.rels new file mode 100644 index 0000000..3107a8e --- /dev/null +++ b/ui/processor/.rels @@ -0,0 +1,2 @@ + + \ No newline at end of file diff --git a/ui/processor/customUI.xml b/ui/processor/customUI.xml new file mode 100644 index 0000000..983976a --- /dev/null +++ b/ui/processor/customUI.xml @@ -0,0 +1,63 @@ + + + + + + + + + + + + + + + + + + + \ No newline at end of file