commit 879fd2ef5117a5724d00bed6d89cc596ad2c1d66
Author: IRBorisov <8611739+IRBorisov@users.noreply.github.com>
Date: Fri Jun 7 20:27:50 2024 +0300
Initial commit
diff --git a/VBAMake.txt b/VBAMake.txt
new file mode 100644
index 0000000..2883fb9
--- /dev/null
+++ b/VBAMake.txt
@@ -0,0 +1,37 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact_home, source_home
+
+id = ExcelHelper
+name = ExcelHelper
+description = Надстройка КОНЦЕПТ для Excel
+artifact_home = Addins
+source_home = ExcelAI
+install_home = \\fs1.concept.ru\projects\04 Направления деятельности\60 КИВТ\21 Надстройки\EXCEL
+
+%%
+# === Build section ===
+# Available commands:
+# build LOCAL_MANIFEST
+# copy LOCAL_SOURCE -> [LOCAL_ARTIFACT]
+# save_as LOCAL_ARTIFACT -> LOCAL_ARTIFACT
+# run LOCAL_SOURCE.bat
+
+build script\manifest.txt
+save_as CONCEPT.xlsm -> CONCEPT.xlam
+copy distr\Excel.docx
+
+%%
+# === Install section ==
+# Available commands:
+# install LOCAL_ARTIFACT -> [INSTALL_PATH]
+# add_template LOCAL_ARTIFACT -> [LOCAL_TEMPLATE]
+# run LOCAL_ARTIFACT.bat <- [PARAMETERS]
+# run APPLICATION <- [PARAMETERS]
+
+install CONCEPT.xlam
+install CONCEPT.xlam -> \\fs1.concept.ru\Exchange\ConceptDistr\data\Add-ins\Excel\CONCEPT.xlam
+
+install Excel.docx
+install Excel.docx -> \\fs1.concept.ru\projects\10 Автоматизация деятельности\02 Офисная автоматизация\!Надстройки\Excel.docx
\ No newline at end of file
diff --git a/VERSION b/VERSION
new file mode 100644
index 0000000..88c5fb8
--- /dev/null
+++ b/VERSION
@@ -0,0 +1 @@
+1.4.0
diff --git a/distr/Excel.docx b/distr/Excel.docx
new file mode 100644
index 0000000..eb72bb4
Binary files /dev/null and b/distr/Excel.docx differ
diff --git a/script/manifest.txt b/script/manifest.txt
new file mode 100644
index 0000000..86964a5
--- /dev/null
+++ b/script/manifest.txt
@@ -0,0 +1,93 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact
+
+name = CONCEPT.xlsm
+artifact = CONCEPT.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_Python.bas
+ ex_WinAPI.bas
+ ex_ConceptCore.bas
+
+ API_Python.cls
+ API_Path.cls
+ API_WordWrapper.cls
+ API_XLWrapper.cls
+ API_UserInteraction.cls
+
+excel
+ ex_Excel.bas
+
+utility
+ ex_VBA.bas
+ ex_DataPreparation.bas
+ ex_Version.bas
+
+ API_DistrManifest.cls
+ API_Config.cls
+ API_JSON.cls
+ API_Timer.cls
+
+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
+ DevHelper.bas
+ Declarations.bas
+ Main.bas
+ MainImpl.bas
+ PublicFunctions.bas
+ z_UIMessages.bas
+ z_UIRibbon.bas
+
+ AddinOptions.cls
+ CellProcessor.cls
+ LinksOutput.cls
+ LinksRelocator.cls
+ SearchEngine.cls
+ ParametersSearch.cls
+
+ WordDlg.frm
+ RelocateDlg.frm
+ SearchDlg.frm
+
+%%
+# ===== 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
+
+.rels -> _rels\.rels
+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 : Word
+global : Shell32
+global : ADODB
+global : IWshRuntimeLibrary
\ No newline at end of file
diff --git a/skeleton/CONCEPT.xlsm b/skeleton/CONCEPT.xlsm
new file mode 100644
index 0000000..23e947b
Binary files /dev/null and b/skeleton/CONCEPT.xlsm differ
diff --git a/src/AddinOptions.cls b/src/AddinOptions.cls
new file mode 100644
index 0000000..d8fe90b
--- /dev/null
+++ b/src/AddinOptions.cls
@@ -0,0 +1,31 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "AddinOptions"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public data_ As Scripting.Dictionary
+
+Private Sub Class_Initialize()
+ Set data_ = New Scripting.Dictionary
+ Dim nItem&
+ For nItem = TWordAddin.[_First] To TWordAddin.[_Last] Step 1
+ data_.Item(nItem) = False
+ Next nItem
+End Sub
+
+Public Function CheckProductEnabled(sProduct$) As Boolean
+ Dim nItem&
+ For nItem = TWordAddin.[_First] To TWordAddin.[_Last] Step 1
+ If sProduct = ProductNameFromID(nItem) Then
+ CheckProductEnabled = data_.Item(nItem)
+ Exit Function
+ End If
+ Next nItem
+ CheckProductEnabled = True
+End Function
diff --git a/src/CellProcessor.cls b/src/CellProcessor.cls
new file mode 100644
index 0000000..b272fa0
--- /dev/null
+++ b/src/CellProcessor.cls
@@ -0,0 +1,84 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "CellProcessor"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public countAll_ As Long
+Public countInvalid_ As Long
+
+Private fso_ As Scripting.FileSystemObject
+
+Public Function Init()
+ countAll_ = 0
+ countInvalid_ = 0
+ Set fso_ = New Scripting.FileSystemObject
+End Function
+
+Public Function TrimCell(target As Excel.Range)
+ target = TrimWhitespace(target.Text)
+End Function
+
+Public Function TrimCellPunctuation(target As Excel.Range)
+ target = TrimEndPunctuation(target.Text)
+End Function
+
+Public Function SubstituteWS(target As Excel.Range)
+ target = SubstituteWhitespace(target.Text)
+End Function
+
+Public Function CreateHyperlink(target As Excel.Range)
+ Call XLUpdateHyperlink(target, target.Text)
+End Function
+
+Public Function SplitTextIntoColumn(target As Excel.Range)
+ Dim vWords As Variant: vWords = VBA.Split(target.Text, " ")
+ If VBA.VarType(vWords) < vbArray Or VBA.VarType(vWords) > vbArray + vbByte Then _
+ Call Err.Raise(1000, Description:=vWords)
+
+ Dim output As Excel.Range: Set output = target
+ Dim sWord As Variant
+ For Each sWord In vWords
+ Set output = output.Offset(1, 0)
+ output = CStr(sWord)
+ Next sWord
+End Function
+
+Public Function ValidateHyperlink(target As Excel.Range)
+ If target.Hyperlinks.Count = 0 Then _
+ Exit Function
+
+ countAll_ = countAll_ + 1
+ If IsValidHyperlink(target) Then
+ target.Interior.ColorIndex = xlNone
+ Else
+ target.Interior.Color = VBA.RGB(253, 233, 217)
+ countInvalid_ = countInvalid_ + 1
+ End If
+End Function
+
+Public Function FixServerLink(target As Excel.Range)
+ countAll_ = countAll_ + 1
+
+ Dim iPath As New API_Path: Call iPath.FromString(target.Text).GlobalToServer
+ If iPath.Text = target.Text Then _
+ Exit Function
+
+ target = iPath.Text
+ Call XLUpdateHyperlink(target, iPath.Text)
+ countInvalid_ = countInvalid_ + 1
+End Function
+
+' ======
+Private Function IsValidHyperlink(target As Excel.Range) As Boolean
+ Dim sFile$: sFile = target.Hyperlinks(1).Address
+ Dim iPath As New API_Path: Call iPath.FromString(sFile).ToGlobal(target.Parent.Parent.Path)
+ IsValidHyperlink = iPath.GlobalExists
+End Function
+
+
diff --git a/src/Declarations.bas b/src/Declarations.bas
new file mode 100644
index 0000000..80e0b0c
--- /dev/null
+++ b/src/Declarations.bas
@@ -0,0 +1,47 @@
+Attribute VB_Name = "Declarations"
+Option Private Module
+Option Explicit
+
+Public Const APP_HELP = "\\fs1.concept.ru\projects\10 \02 \!\Excel.docx"
+
+Public Const CONCEPT_LOCAL_HOME = ".concept"
+Public Const CONCEPT_SERVER_HOME = "\\fs1.concept.ru\projects\10 \!Concept"
+
+Public Const CONCEPT_BANNED_WORDS = "banned-words.txt"
+
+Public Const SERVER_TEMPLATES_FOLDER = "\\fs1.concept.ru\Data\Templates"
+Public Const LOCAL_TEMPLATES_FOLDER = "Microsoft\"
+
+Public Const PROJECTS_FIRST_ROW = 2
+Public Const VISIO_DEFAULT_GAP = 0.254
+
+' Matching mode
+Public Enum TMatchMode
+ T_MM_DEFAULT = 1
+ T_MM_SPACE_LEFT = 2
+ T_MM_SPACE_RIGHT = 3
+ T_MM_SPACE_BOTH = 4
+End Enum
+
+' Word Addins
+Public Enum TWordAddin
+ [_First] = 1
+
+ T_WA_CONCEPT = 1
+ T_WA_NPA = 2
+ T_WA_MARKUP = 3
+ T_WA_PARSERS = 4
+ T_WA_MAKET = 5
+
+ [_Last] = 5
+End Enum
+
+Public Function ProductNameFromID(nID As TWordAddin) As String
+ Select Case nID
+ Case T_WA_CONCEPT: ProductNameFromID = "WordHelper"
+ Case T_WA_NPA: ProductNameFromID = "Concept-NPA"
+ Case T_WA_MARKUP: ProductNameFromID = "Concept-Markup"
+ Case T_WA_PARSERS: ProductNameFromID = "Concept-Mining"
+ Case T_WA_MAKET: ProductNameFromID = "Concept-Maket"
+ End Select
+End Function
diff --git a/src/DevHelper.bas b/src/DevHelper.bas
new file mode 100644
index 0000000..f26d7d8
--- /dev/null
+++ b/src/DevHelper.bas
@@ -0,0 +1,20 @@
+Attribute VB_Name = "DevHelper"
+Option Explicit
+
+Public Function Dev_PrepareSkeleton()
+ ' Do nothing
+End Function
+
+Public Sub 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 Sub
+
+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/LinksOutput.cls b/src/LinksOutput.cls
new file mode 100644
index 0000000..5196f76
--- /dev/null
+++ b/src/LinksOutput.cls
@@ -0,0 +1,36 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "LinksOutput"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private out_ As Excel.Range
+Private mask_ As String
+
+Public countAdded_ As Long
+Public countAll_ As Long
+
+Public Function Init(iOut As Excel.Range, sMask$)
+ Set out_ = iOut
+ countAdded_ = 0
+ countAll_ = 0
+ mask_ = sMask
+End Function
+
+Public Function ProcessFile(iFile As Scripting.File)
+ countAll_ = countAll_ + 1
+ If Not iFile.Path Like mask_ Then _
+ Exit Function
+
+ Dim iCell As Excel.Range: Set iCell = out_.Offset(countAdded_, 0)
+ iCell = iFile.Path
+
+ On Error Resume Next
+ Call iCell.Hyperlinks.Add(iCell, iFile.Path)
+ countAdded_ = countAdded_ + 1
+End Function
diff --git a/src/LinksRelocator.cls b/src/LinksRelocator.cls
new file mode 100644
index 0000000..9881efd
--- /dev/null
+++ b/src/LinksRelocator.cls
@@ -0,0 +1,76 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "LinksRelocator"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private fso_ As Scripting.FileSystemObject
+Private prefix_ As String
+Private destination_ As String
+Private home_ As String
+Private removeSource_ As Boolean
+
+Public countAll_ As Long
+Public countRelocated_ As Long
+
+Public Function Init(sDestination$, sPrefix$, sHome$, bRemoveSource As Boolean)
+ Set fso_ = New Scripting.FileSystemObject
+ prefix_ = sPrefix
+ destination_ = sDestination
+ home_ = sHome
+ removeSource_ = bRemoveSource
+
+ countAll_ = 0
+ countRelocated_ = 0
+End Function
+
+Public Function ProcessCell(target As Excel.Range)
+ If target.Hyperlinks.Count = 0 Then _
+ Exit Function
+
+ countAll_ = countAll_ + 1
+ Dim iPath As New API_Path: Call iPath.FromString(target.Value).ToGlobal(home_)
+ Dim iRelativePath As API_Path: Set iRelativePath = iPath.Clone.ToLocal(prefix_)
+ If iRelativePath.Text = iPath.Text Then _
+ Set iRelativePath = GenerateLocalPath(iPath.FileName)
+
+ If Not iPath.GlobalExists Then _
+ GoTo MARK_FAILURE
+
+ Dim iDestination As API_Path: Set iDestination = iRelativePath.Clone
+ Call iDestination.ToGlobal(destination_)
+
+ If removeSource_ Then
+ If Not MoveFileOrFolder(iPath.Text, iDestination.Text, fso_) Then _
+ GoTo MARK_FAILURE
+ Else
+ If Not CopyFileOrFolder(iPath.Text, iDestination.Text, fso_) Then _
+ GoTo MARK_FAILURE
+ End If
+
+ target = iDestination.Text
+ Call XLUpdateHyperlink(target, iDestination.Text)
+ target.Interior.ColorIndex = xlNone
+ countRelocated_ = countRelocated_ + 1
+ Exit Function
+
+MARK_FAILURE:
+ target.Interior.Color = VBA.RGB(253, 233, 217)
+End Function
+
+' ======
+Private Function GenerateLocalPath(sName$) As API_Path
+ Dim iPath As New API_Path: Call iPath.FromString(sName)
+ Call iPath.ToGlobal(destination_)
+ Dim nCopy&: nCopy = 1
+ Do While iPath.GlobalExists
+ Call iPath.FromString(Fmt("{1}_{2}.{3}", iPath.BaseName, nCopy, iPath.Extension))
+ Call iPath.ToGlobal(destination_)
+ Loop
+ Set GenerateLocalPath = iPath
+End Function
diff --git a/src/Main.bas b/src/Main.bas
new file mode 100644
index 0000000..2041dce
--- /dev/null
+++ b/src/Main.bas
@@ -0,0 +1,295 @@
+Attribute VB_Name = "Main"
+Option Explicit
+Option Private Module
+
+Public Sub CC_RunGroupByRank()
+ Dim iSelection As Excel.Range: Set iSelection = ActiveWorkbook.Application.Selection
+ Dim nRow&: nRow = 1
+ Dim sTxt$
+ Do
+ sTxt = iSelection.Cells(nRow, 1)
+ If sTxt = vbNullString Then _
+ Exit Do
+ If IsNumeric(sTxt) Then _
+ iSelection.Rows(nRow).OutlineLevel = CLng(sTxt)
+ nRow = nRow + 1
+ Loop
+End Sub
+
+Public Sub CC_RunGroupByID()
+ Dim iSelection As Excel.Range: Set iSelection = ActiveWorkbook.Application.Selection
+ Dim nRow&: nRow = 1
+ Dim lastID$: lastID = vbNullString
+ Dim curID$
+ Do
+ curID = iSelection.Cells(nRow, 1)
+ If curID = vbNullString Then _
+ Exit Do
+ iSelection.Rows(nRow).OutlineLevel = IIf(lastID = curID, 2, 1)
+ lastID = curID
+ nRow = nRow + 1
+ Loop
+End Sub
+
+Public Sub CC_RunClearFormatting()
+ Dim iSelection As Excel.Range: Set iSelection = ActiveWorkbook.Application.Selection
+ Do While iSelection.FormatConditions.Count > 0
+ Call iSelection.FormatConditions.Item(1).Delete
+ Loop
+End Sub
+
+Public Sub CC_RunTrimCells()
+ Call XLForEachNonEmptyCell( _
+ target:=ActiveWorkbook.Application.Selection, _
+ oCallback:=New CellProcessor, _
+ sFuncName:="TrimCell")
+End Sub
+
+Public Sub CC_RunTrimPunctuation()
+ Call XLForEachNonEmptyCell( _
+ target:=ActiveWorkbook.Application.Selection, _
+ oCallback:=New CellProcessor, _
+ sFuncName:="TrimCellPunctuation")
+End Sub
+
+Public Sub CC_RunSubstituteWhitespace()
+ Call XLForEachNonEmptyCell( _
+ target:=ActiveWorkbook.Application.Selection, _
+ oCallback:=New CellProcessor, _
+ sFuncName:="SubstituteWS")
+End Sub
+
+Public Sub CC_RunLinksCreate()
+ Call XLForEachNonEmptyCell( _
+ target:=ActiveWorkbook.Application.Selection, _
+ oCallback:=New CellProcessor, _
+ sFuncName:="CreateHyperlink")
+End Sub
+
+Public Sub CC_RunSplitText()
+ Call XLForEachNonEmptyCell( _
+ target:=ActiveWorkbook.Application.Selection, _
+ oCallback:=New CellProcessor, _
+ sFuncName:="SplitTextIntoColumn")
+End Sub
+
+Public Sub CC_RunLinksScan()
+ Dim sMask$: sMask = UserInteraction.PromptInput(" ", sInitial:="*.*")
+ If sMask = vbNullString Then _
+ Exit Sub
+ Dim sFolder$: sFolder = UserInteraction.PromptFolder(ActiveWorkbook.Path & "\")
+ If sFolder = vbNullString Then _
+ Exit Sub
+
+ Dim iScanner As New LinksOutput: Call iScanner.Init(ActiveWorkbook.Application.Selection.Cells(1, 1), sMask)
+ Call ForEachFileRecursive(sFolder, iScanner, "ProcessFile")
+
+ Call UserInteraction.ShowMessage(IM_LINKS_SCAN_OK, iScanner.countAdded_, iScanner.countAll_)
+End Sub
+
+Public Sub CC_RunLinksValidate()
+ Dim iProcessor As New CellProcessor: Call iProcessor.Init
+ Call XLForEachNonEmptyCell( _
+ target:=ActiveWorkbook.Application.Selection, _
+ oCallback:=iProcessor, _
+ sFuncName:="ValidateHyperlink")
+ Call UserInteraction.ShowMessage(IM_LINKS_VALIDATION, iProcessor.countInvalid_, iProcessor.countAll_)
+End Sub
+
+Public Sub CC_RunLinksServer()
+ Dim iProcessor As New CellProcessor: Call iProcessor.Init
+ Call XLForEachNonEmptyCell( _
+ target:=ActiveWorkbook.Application.Selection, _
+ oCallback:=iProcessor, _
+ sFuncName:="FixServerLink")
+ Call UserInteraction.ShowMessage(IM_LINKS_SERVER, iProcessor.countInvalid_, iProcessor.countAll_)
+End Sub
+
+Public Sub CC_RunLinksRelocate()
+ Dim iTarget As Excel.Workbook: Set iTarget = ActiveWorkbook
+ Dim iSelection As Excel.Range: Set iSelection = iTarget.Application.Selection
+ If iSelection.Hyperlinks.Count = 0 Then
+ Call UserInteraction.ShowMessage(EM_SELECTION_NO_HYPERLINKS)
+ Exit Sub
+ End If
+
+ Dim fso As New Scripting.FileSystemObject
+ Dim sInitFolder$: sInitFolder = fso.GetParentFolderName(iSelection.Hyperlinks(1).Address)
+ Call RelocateDlg.Init(sInitFolder)
+ Call RelocateDlg.Show
+ If RelocateDlg.isCancelled_ Then _
+ Exit Sub
+
+ Dim iProcessor As New LinksRelocator: Call iProcessor.Init(RelocateDlg.Path, RelocateDlg.Prefix, iTarget.Path, bRemoveSource:=True)
+ Call XLForEachNonEmptyCell( _
+ target:=ActiveWorkbook.Application.Selection, _
+ oCallback:=iProcessor, _
+ sFuncName:="ProcessCell")
+
+ Call UserInteraction.ShowMessage(IM_LINKS_RELOCATE_OK, iProcessor.countRelocated_, iProcessor.countAll_)
+End Sub
+
+Public Sub CC_RunLinksCopyFiles()
+ Dim iTarget As Excel.Workbook: Set iTarget = ActiveWorkbook
+ Dim iSelection As Excel.Range: Set iSelection = iTarget.Application.Selection
+ If iSelection.Hyperlinks.Count = 0 Then
+ Call UserInteraction.ShowMessage(EM_SELECTION_NO_HYPERLINKS)
+ Exit Sub
+ End If
+
+ Dim fso As New Scripting.FileSystemObject
+ Dim sInitFolder$: sInitFolder = fso.GetParentFolderName(iSelection.Hyperlinks(1).Address)
+ Call RelocateDlg.Init(sInitFolder)
+ Call RelocateDlg.Show
+ If RelocateDlg.isCancelled_ Then _
+ Exit Sub
+
+ Dim iProcessor As New LinksRelocator: Call iProcessor.Init(RelocateDlg.Path, RelocateDlg.Prefix, iTarget.Path, bRemoveSource:=False)
+ Call XLForEachNonEmptyCell( _
+ target:=ActiveWorkbook.Application.Selection, _
+ oCallback:=iProcessor, _
+ sFuncName:="ProcessCell")
+
+ Call UserInteraction.ShowMessage(IM_LINKS_COPY_OK, iProcessor.countRelocated_, iProcessor.countAll_)
+End Sub
+
+Public Sub CC_RunListIncome()
+ Dim iProjects As Scripting.Dictionary: Set iProjects = CCListProjects(T_PRJ_INCOME)
+ If iProjects Is Nothing Then _
+ Exit Sub
+ Call PasteProjects(Excel.ActiveWindow.ActiveCell, iProjects)
+End Sub
+
+Public Sub CC_RunListOutcome()
+ Dim iProjects As Scripting.Dictionary: Set iProjects = CCListProjects(T_PRJ_OUTCOME)
+ If iProjects Is Nothing Then _
+ Exit Sub
+ Call PasteProjects(Excel.ActiveWindow.ActiveCell, iProjects)
+End Sub
+
+Public Sub CC_RunListLeads()
+ Dim iProjects As Scripting.Dictionary: Set iProjects = CCListProjects(T_PRJ_LEAD_ACTIVE)
+ If iProjects Is Nothing Then _
+ Exit Sub
+ Call PasteProjects(Excel.ActiveWindow.ActiveCell, iProjects)
+End Sub
+
+Public Sub CC_RunListTentative()
+ Dim iProjects As Scripting.Dictionary: Set iProjects = CCListProjects(T_PRJ_LEAD_TENTATIVE)
+ If iProjects Is Nothing Then _
+ Exit Sub
+ Call PasteProjects(Excel.ActiveWindow.ActiveCell, iProjects)
+End Sub
+
+Public Sub CC_RunLinksPrint()
+ Dim selRange As Excel.Range: Set selRange = ActiveWorkbook.Application.Selection
+ Dim theLinks As Excel.Hyperlinks: Set theLinks = selRange.Hyperlinks
+ If theLinks.Count = 0 Then
+ Call UserInteraction.ShowMessage(EM_SELECTION_NO_HYPERLINKS)
+ Exit Sub
+ End If
+
+ Call PrintLinks(theLinks)
+End Sub
+
+Public Sub CC_RunConfig()
+ Dim fso As New Scripting.FileSystemObject
+ Dim sConfigPath$: sConfigPath = ConceptConfigPath
+ If Not fso.FileExists(sConfigPath) Then _
+ Call SetupConfig(sConfigPath)
+
+ Dim oShell As New Shell32.Shell
+ Call oShell.Open(sConfigPath)
+End Sub
+
+Public Sub CC_RunWordAddin()
+ If Not ValidateNoWordOpen Then
+ Call UserInteraction.ShowMessage(EM_WORD_IS_OPEN)
+ Exit Sub
+ End If
+
+ Dim iCurrent As AddinOptions: Set iCurrent = ScanAddinOptions()
+ Call WordDlg.Init(iCurrent)
+ Call WordDlg.Show
+ If WordDlg.isCanceled_ Then _
+ Exit Sub
+
+ If ApplyAddins(iCurrent, WordDlg.GetResult) Then
+ Call UserInteraction.ShowMessage(IM_WORD_ADDINS_OK)
+ Else
+ Call UserInteraction.ShowMessage(EM_WORD_ADDINS_FAILED)
+ End If
+End Sub
+
+Public Sub CC_RunUpdateTemplates()
+ If Not ValidateNoWordOpen Then
+ Call UserInteraction.ShowMessage(EM_WORD_IS_OPEN)
+ Exit Sub
+ End If
+
+ If CopyFileOrFolder( _
+ sSource:=SERVER_TEMPLATES_FOLDER, _
+ sDestination:=VBA.Environ$("APPDATA") & "\" & LOCAL_TEMPLATES_FOLDER) Then
+ Call UserInteraction.ShowMessage(IM_TEMPLATES_OK)
+ Else
+ Call UserInteraction.ShowMessage(EM_TEMPLATES_FAILED)
+ End If
+End Sub
+
+Public Sub CC_RunUpdateConceptCore()
+ Call AccessPython.UnloadDLL
+ Call UnloadConceptCore
+
+ If Not UpdateConceptPowershell Then
+ Call UserInteraction.ShowMessage(EM_CORE_UPDATE_FAILED)
+ Exit Sub
+ End If
+
+ Call UnregisterUDF
+ Call RegisterUDF
+ Call UserInteraction.ShowMessage(IM_CONCEPT_UPDATE_OK)
+End Sub
+
+Public Sub CC_RunConceptStatus()
+ Dim iExcel As New API_XLWrapper
+ Call iExcel.NewDocument
+
+ Call OutputConceptStatus(iExcel.Document.Sheets(1))
+
+ Call iExcel.Document.Activate
+End Sub
+
+Public Sub CC_RunAppdata()
+ Dim oShell As New Shell32.Shell
+ Call oShell.Open(VBA.Environ$("APPDATA") & "\Microsoft")
+End Sub
+
+Public Sub CC_RunAnalyseSearch()
+ Dim iDoc As Excel.Workbook: Set iDoc = Excel.ActiveWorkbook
+
+ Call SearchDlg.Init(iDoc)
+ Call SearchDlg.Show
+ If SearchDlg.isCancelled_ Then _
+ Exit Sub
+
+ Dim params As ParametersSearch: Set params = SearchDlg.ResultParams
+ Call ExecuteSearch(iDoc, params)
+
+ Call UserInteraction.ShowMessage(IM_SEARCH_OK)
+End Sub
+
+Public Sub CC_RunHelp()
+ Dim iWord As New API_WordWrapper
+ Dim iHelp As Word.Document: Set iHelp = iWord.OpenDocument(APP_HELP, bReadOnly:=True)
+ If iHelp Is Nothing Then _
+ Exit Sub
+
+ With iHelp
+ .ActiveWindow.View.ReadingLayout = False
+ Call .Application.Activate
+ End With
+End Sub
+
+Public Sub CC_RunDescriptionUDF()
+ Call RegisterUDF
+End Sub
diff --git a/src/MainImpl.bas b/src/MainImpl.bas
new file mode 100644
index 0000000..8b437c2
--- /dev/null
+++ b/src/MainImpl.bas
@@ -0,0 +1,168 @@
+Attribute VB_Name = "MainImpl"
+Option Explicit
+Option Private Module
+
+Public Function PasteProjects(ByVal rWhere As Excel.Range, iProjects As Scripting.Dictionary)
+ If iProjects.Count = 0 Then _
+ Exit Function
+
+ Set rWhere = rWhere.Cells(1, 1)
+ If Not IsEmpty(rWhere) Then
+ Call rWhere.Offset(1).EntireRow.Insert
+ Set rWhere = rWhere.Offset(1)
+ End If
+
+ Dim aKey As Variant
+ For Each aKey In iProjects
+ If IsEmpty(rWhere) Then _
+ GoTo PASTE_PRJ
+
+ Call rWhere.EntireRow.Insert
+ Set rWhere = rWhere.Offset(-1)
+ Call rWhere.Offset(-1).Copy(rWhere)
+
+PASTE_PRJ:
+ rWhere = CStr(aKey)
+ Set rWhere = rWhere.Offset(1)
+ Next aKey
+End Function
+
+Public Function PrintLinks(iLinks As Excel.Hyperlinks)
+ Dim fso As New Scripting.FileSystemObject
+ Dim iShell As New Shell32.Shell
+ Dim aLink As Excel.Hyperlink
+ For Each aLink In iLinks
+ Dim sAddress$: sAddress = fso.GetAbsolutePathName(aLink.Address)
+ If sAddress = vbNullString Then _
+ GoTo NEXT_LINK
+ If Not fso.FileExists(sAddress) Then _
+ GoTo NEXT_LINK
+ Call iShell.ShellExecute(sAddress, vOperation:="Print")
+
+NEXT_LINK:
+ Next aLink
+End Function
+
+Public Function SetupConfig(sPath$)
+ Dim iConfig As API_Config: Set iConfig = ConceptConfig
+ Call iConfig.SaveToFile(sPath)
+End Function
+
+Public Function ValidateNoWordOpen() As Boolean
+ On Error Resume Next
+ Dim iWord As Word.Application: Set iWord = GetObject(, "Word.Application")
+ ValidateNoWordOpen = Err.Number <> 0 Or iWord Is Nothing
+ On Error GoTo 0
+End Function
+
+Public Function ScanAddinOptions() As AddinOptions
+ Dim fso As New Scripting.FileSystemObject
+ Dim sLocals$: sLocals = VBA.Environ$("APPDATA") & "\Microsoft\Word\STARTUP"
+ Set ScanAddinOptions = New AddinOptions
+ With ScanAddinOptions
+ .data_.Item(T_WA_CONCEPT) = fso.FileExists(sLocals & "\" & ADDIN_NAME_CONCEPT)
+ .data_.Item(T_WA_NPA) = fso.FileExists(sLocals & "\" & ADDIN_NAME_NPA)
+ .data_.Item(T_WA_MARKUP) = fso.FileExists(sLocals & "\" & ADDIN_NAME_MARKUP)
+ .data_.Item(T_WA_PARSERS) = fso.FileExists(sLocals & "\" & ADDIN_NAME_PARSER)
+ .data_.Item(T_WA_MAKET) = fso.FileExists(sLocals & "\" & ADDIN_NAME_MAKET)
+ End With
+End Function
+
+Public Function ApplyAddins(iCurrent As AddinOptions, iNew As AddinOptions) As Boolean
+ ApplyAddins = False
+
+ Dim sParams$
+ Dim nID As TWordAddin
+ For nID = TWordAddin.[_First] To TWordAddin.[_Last] Step 1
+ If iNew.data_.Item(nID) Then
+ If sParams <> vbNullString Then _
+ sParams = sParams & ", "
+ sParams = sParams & ProductNameFromID(nID) & "+"
+ ElseIf iCurrent.data_.Item(nID) Then
+ If sParams <> vbNullString Then _
+ sParams = sParams & ", "
+ sParams = sParams & ProductNameFromID(nID) & "-"
+ End If
+ Next nID
+
+ ApplyAddins = VersionUpdateProducts(sParams)
+End Function
+
+Public Function ExecuteSearch(target As Excel.Workbook, params As ParametersSearch)
+ Dim iOut As Excel.Worksheet: Set iOut = target.Sheets.Add
+ Dim iEngine As New SearchEngine
+ Call iEngine.Init(iOut, params)
+ Call iEngine.Execute
+End Function
+
+Public Function UpdateConceptPowershell() As Boolean
+ UpdateConceptPowershell = False
+
+ Dim fso As New Scripting.FileSystemObject
+ Dim sInstall$: sInstall = CP_TOOLS_SERVER & "\" & CONCEPT_INSTALLER
+ If Not fso.FileExists(sInstall) Then _
+ Exit Function
+
+ On Error GoTo RETURN_FALSE
+ Dim sExec$: sExec = "cmd.exe /c " & """" & sInstall & """" & " < nul"
+ Dim iShell As New WshShell
+ iShell.CurrentDirectory = CP_TOOLS_SERVER
+ UpdateConceptPowershell = iShell.Run(sExec, waitOnReturn:=True) = 0
+ Exit Function
+
+RETURN_FALSE:
+ On Error GoTo 0
+End Function
+
+Public Function OutputConceptStatus(iOut As Excel.Worksheet)
+ With iOut
+ .Cells(1, 1) = "ProductID"
+ .Cells(1, 2) = " "
+ .Cells(1, 3) = " "
+ .Cells(1, 4) = " "
+ .Columns(1).ColumnWidth = 25
+ .Columns(2).ColumnWidth = 15
+ .Columns(3).ColumnWidth = 15
+ .Columns(4).ColumnWidth = 15
+ End With
+
+ Dim nRow&: nRow = 2
+
+ Dim iLocal As API_DistrManifest: Set iLocal = VersionLocalManifest
+ Dim iServer As API_DistrManifest: Set iServer = VersionServerManifest
+ Dim iEnabled As AddinOptions: Set iEnabled = ScanAddinOptions
+
+ Dim iProduct As Variant
+ For Each iProduct In iLocal.data_.Keys
+ Dim sProduct$: sProduct = VBA.CStr(iProduct)
+
+ Dim sLocalVer$: sLocalVer = iLocal.GetVersion(sProduct)
+ If sLocalVer = vbNullString Then _
+ sLocalVer = " "
+
+ Dim sServerVer$: sServerVer = iServer.GetVersion(sProduct)
+ If sServerVer = vbNullString Then _
+ sServerVer = " "
+
+ With iOut
+ .Cells(nRow, 1) = sProduct
+ .Cells(nRow, 2) = sLocalVer
+ .Cells(nRow, 3) = sServerVer
+ .Cells(nRow, 4) = IIf(iEnabled.CheckProductEnabled(sProduct), "", "")
+ End With
+ nRow = nRow + 1
+ Next iProduct
+End Function
+
+' =======
+Private Function ScanProjects(iSource As Excel.Worksheet) As Collection
+ Set ScanProjects = New Collection
+ Dim nRow&
+ Dim lstRow&: lstRow = iSource.Cells(iSource.Rows.Count, 1).End(xlUp).Row
+ nRow = PROJECTS_FIRST_ROW
+ For nRow = PROJECTS_FIRST_ROW To lstRow Step 1
+ Dim sTxt$: sTxt = iSource.Cells(nRow, 1)
+ If sTxt <> vbNullString Then _
+ Call ScanProjects.Add(sTxt)
+ Next nRow
+End Function
diff --git a/src/ParametersSearch.cls b/src/ParametersSearch.cls
new file mode 100644
index 0000000..9e78093
--- /dev/null
+++ b/src/ParametersSearch.cls
@@ -0,0 +1,20 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "ParametersSearch"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public searchWhere_ As Excel.Range
+Public searchWhat_ As Excel.Range
+
+Public partialMatch_ As Boolean
+Public normalize_ As Boolean
+Public outputText_ As Boolean
+
+Public ignoreSmall_ As Boolean
+Public smallSize_ As Long
diff --git a/src/PublicFunctions.bas b/src/PublicFunctions.bas
new file mode 100644
index 0000000..f8825c1
--- /dev/null
+++ b/src/PublicFunctions.bas
@@ -0,0 +1,639 @@
+Attribute VB_Name = "PublicFunctions"
+' User defined function to use in Cells formula
+Option Explicit
+
+Private Const BLANKS_LIMIT = 300
+
+Public Sub RegisterUDF()
+ Dim xlApp As Excel.Application: Set xlApp = ThisWorkbook.Application
+
+ Call xlApp.MacroOptions(Macro:="RS_ToASCII", Category:="CONCEPT_RS", _
+ Description:=" Unicode ASCII")
+ Call xlApp.MacroOptions(Macro:="RS_ToMath", Category:="CONCEPT_RS", _
+ Description:=" ASCII Unicode")
+ Call xlApp.MacroOptions(Macro:="RS_ToTree", Category:="CONCEPT_RS", _
+ Description:=" ASCII ")
+
+ Call xlApp.MacroOptions(Macro:="PY_Parse", Category:="CONCEPT_PYTHON", _
+ Description:=" " & vbNewLine & _
+ " , ")
+ Call xlApp.MacroOptions(Macro:="PY_Normalize", Category:="CONCEPT_PYTHON", _
+ Description:=" ")
+ Call xlApp.MacroOptions(Macro:="PY_Inflect", Category:="CONCEPT_PYTHON", _
+ Description:=" ")
+ Call xlApp.MacroOptions(Macro:="PY_InflectSubstitute", Category:="CONCEPT_PYTHON", _
+ Description:=" , " & vbNewLine & _
+ " , " & vbNewLine & _
+ " ")
+ Call xlApp.MacroOptions(Macro:="PY_InflectDependant", Category:="CONCEPT_PYTHON", _
+ Description:=" , " & vbNewLine & _
+ " , ")
+ Call xlApp.MacroOptions(Macro:="PY_InflectContext", Category:="CONCEPT_PYTHON", _
+ Description:=" , " & vbNewLine & _
+ " " & vbNewLine & _
+ " ")
+ Call xlApp.MacroOptions(Macro:="PY_FindSubstr", Category:="CONCEPT_PYTHON", _
+ Description:=" ")
+
+ Call xlApp.MacroOptions(Macro:="CC_AbbreviateText", Category:="CONCEPT", _
+ Description:=" ")
+ Call xlApp.MacroOptions(Macro:="CC_TrimWhitespace", Category:="CONCEPT", _
+ Description:=" ")
+ Call xlApp.MacroOptions(Macro:="CC_TrimPunctuation", Category:="CONCEPT", _
+ Description:=" ")
+ Call xlApp.MacroOptions(Macro:="CC_SubstituteWhitespace", Category:="CONCEPT", _
+ Description:=" . ")
+
+ Call xlApp.MacroOptions(Macro:="CC_CutRight", Category:="CONCEPT", _
+ Description:=" " & vbNewLine & _
+ "cutWhat - " & vbNewLine & _
+ "cutWhere - -" & vbNewLine & _
+ "[keepDelim=FALSE] - ")
+
+ Call xlApp.MacroOptions(Macro:="CC_CutLeft", Category:="CONCEPT", _
+ Description:=" " & vbNewLine & _
+ "cutWhat - " & vbNewLine & _
+ "cutWhere - -")
+
+ Call xlApp.MacroOptions(Macro:="CC_CountColor", Category:="CONCEPT", _
+ Description:=" " & vbNewLine & _
+ "rData - " & vbNewLine & _
+ "rCriteria - , ")
+
+ Call xlApp.MacroOptions(Macro:="CC_FileMD5", Category:="CONCEPT", _
+ Description:=" - MD5")
+ Call xlApp.MacroOptions(Macro:="CC_FileSHA1", Category:="CONCEPT", _
+ Description:=" - SAH1")
+
+ Call xlApp.MacroOptions(Macro:="CC_ExtactFileName", Category:="CONCEPT", _
+ Description:=" ")
+ Call xlApp.MacroOptions(Macro:="CC_ExtactFileNameText", Category:="CONCEPT", _
+ Description:=" ")
+ Call xlApp.MacroOptions(Macro:="CC_ExtactFileExtension", Category:="CONCEPT", _
+ Description:=" ")
+ Call xlApp.MacroOptions(Macro:="CC_ExtactFolderName", Category:="CONCEPT", _
+ Description:=" , ")
+
+ Call xlApp.MacroOptions(Macro:="CC_HyperlinkToString", Category:="CONCEPT", _
+ Description:=" ")
+
+ Call xlApp.MacroOptions(Macro:="CC_MatchCount", Category:="CONCEPT", _
+ Description:=" ")
+ Call xlApp.MacroOptions(Macro:="CC_MatchMultiple", Category:="CONCEPT", _
+ Description:=" , " & vbNewLine & _
+ "target - " & vbNewLine & _
+ "iMatchList - " & vbNewLine & _
+ "[nMode=1] - " & vbNewLine & _
+ "1 - ( ) - " & vbNewLine & _
+ "2 - " & vbNewLine & _
+ "3 - " & vbNewLine & _
+ "4 - ")
+ Call xlApp.MacroOptions(Macro:="CC_LookupSubstr", Category:="CONCEPT", _
+ Description:=" (HLOOKUP), , ")
+ Call xlApp.MacroOptions(Macro:="CC_LongestDuplicatePrefix", Category:="CONCEPT", _
+ Description:=" , 2 ")
+ Call xlApp.MacroOptions(Macro:="CC_LongestDuplicateSuffix", Category:="CONCEPT", _
+ Description:=" , 2 ")
+ Call xlApp.MacroOptions(Macro:="CC_SLOW_LongestDuplicateSubstring", Category:="CONCEPT", _
+ Description:=" , 2 " & vbNewLine & _
+ "! ")
+
+ Call xlApp.MacroOptions(Macro:="CC_LookupMulti", Category:="CONCEPT", _
+ Description:=" 1 2." & vbNewLine & _
+ " = 3 , 2")
+ Call xlApp.MacroOptions(Macro:="CC_LookupMultiCount", Category:="CONCEPT", _
+ Description:=" LookupMulti, ")
+ Call xlApp.MacroOptions(Macro:="CC_LookupMultiAll", Category:="CONCEPT", _
+ Description:=" LookupMulti, ")
+End Sub
+
+Public Sub UnregisterUDF()
+ Call UnregisterMacto("RS_ToASCII")
+ Call UnregisterMacto("RS_ToMath")
+ Call UnregisterMacto("RS_ToTree")
+ Call UnregisterMacto("PY_Parse")
+ Call UnregisterMacto("PY_Normalize")
+ Call UnregisterMacto("PY_Inflect")
+ Call UnregisterMacto("PY_InflectSubstitute")
+ Call UnregisterMacto("PY_InflectContext")
+ Call UnregisterMacto("PY_InflectDependant")
+ Call UnregisterMacto("PY_FindSubstr")
+ Call UnregisterMacto("CC_AbbreviateText")
+ Call UnregisterMacto("CC_TrimWhitespace")
+ Call UnregisterMacto("CC_TrimPunctuation")
+ Call UnregisterMacto("CC_CutRight")
+ Call UnregisterMacto("CC_CutLeft")
+ Call UnregisterMacto("CC_CountColor")
+ Call UnregisterMacto("CC_FileMD5")
+ Call UnregisterMacto("CC_FileSHA1")
+ Call UnregisterMacto("CC_ExtactFileName")
+ Call UnregisterMacto("CC_ExtactFileNameText")
+ Call UnregisterMacto("CC_ExtactFileExtension")
+ Call UnregisterMacto("CC_ExtactFolderName")
+ Call UnregisterMacto("CC_HyperlinkToString")
+ Call UnregisterMacto("CC_SubstituteWhitespace")
+ Call UnregisterMacto("CC_MatchCount")
+ Call UnregisterMacto("CC_MatchMultiple")
+ Call UnregisterMacto("CC_LookupSubstr")
+ Call UnregisterMacto("CC_LongestDuplicatePrefix")
+ Call UnregisterMacto("CC_LongestDuplicateSuffix")
+ Call UnregisterMacto("CC_SLOW_LongestDuplicateSubstring")
+ Call UnregisterMacto("CC_LookupMulti")
+ Call UnregisterMacto("CC_LookupMulti")
+ Call UnregisterMacto("CC_LookupMultiCount")
+ Call UnregisterMacto("CC_LookupMultiAll")
+End Sub
+
+Public Function RS_ToASCII(sUnicodeText$) As String
+Attribute RS_ToASCII.VB_Description = " Unicode ASCII"
+Attribute RS_ToASCII.VB_ProcData.VB_Invoke_Func = " \n20"
+ RS_ToASCII = MathToASCII(sUnicodeText)
+End Function
+
+Public Function RS_ToMath(sAsciiText$) As String
+Attribute RS_ToMath.VB_Description = " ASCII Unicode"
+Attribute RS_ToMath.VB_ProcData.VB_Invoke_Func = " \n20"
+ RS_ToMath = ASCIItoMath(sAsciiText)
+End Function
+
+Public Function RS_ToTree(sAsciiText$) As String
+Attribute RS_ToTree.VB_Description = " ASCII "
+Attribute RS_ToTree.VB_ProcData.VB_Invoke_Func = " \n20"
+ RS_ToTree = ASCIItoAST(sAsciiText)
+End Function
+
+Public Function PY_Parse(sTarget$, Optional sTags$ = "") As String
+Attribute PY_Parse.VB_Description = " \r\n , "
+Attribute PY_Parse.VB_ProcData.VB_Invoke_Func = " \n21"
+ PY_Parse = AccessPython.CallFunction(PY_MODULE_TEXT, "parse", Array(sTarget, sTags))
+End Function
+
+Public Function PY_Normalize(sTarget$) As String
+Attribute PY_Normalize.VB_Description = " "
+Attribute PY_Normalize.VB_ProcData.VB_Invoke_Func = " \n21"
+ PY_Normalize = AccessPython.CallFunction(PY_MODULE_TEXT, "normalize", Array(sTarget))
+End Function
+
+Public Function PY_Inflect(sTarget$, sTags$) As String
+Attribute PY_Inflect.VB_Description = " "
+Attribute PY_Inflect.VB_ProcData.VB_Invoke_Func = " \n21"
+ PY_Inflect = AccessPython.CallFunction(PY_MODULE_TEXT, "inflect", Array(sTarget, sTags))
+End Function
+
+Public Function PY_InflectSubstitute(sTarget$, sOriginal$) As String
+Attribute PY_InflectSubstitute.VB_Description = " , \r\n , \r\n "
+Attribute PY_InflectSubstitute.VB_ProcData.VB_Invoke_Func = " \n21"
+ PY_InflectSubstitute = AccessPython.CallFunction(PY_MODULE_TEXT, "inflect_substitute", Array(sTarget, sOriginal))
+End Function
+
+Public Function PY_InflectDependant(sTarget$, sMaster$) As String
+Attribute PY_InflectDependant.VB_Description = " , \r\n , "
+Attribute PY_InflectDependant.VB_ProcData.VB_Invoke_Func = " \n21"
+ PY_InflectDependant = AccessPython.CallFunction(PY_MODULE_TEXT, "inflect_dependant", Array(sTarget, sMaster))
+End Function
+
+Public Function PY_InflectContext(sTarget$, Optional sBefore$ = "", Optional sAfter$ = "") As String
+Attribute PY_InflectContext.VB_Description = " , \r\n \r\n "
+Attribute PY_InflectContext.VB_ProcData.VB_Invoke_Func = " \n21"
+ PY_InflectContext = AccessPython.CallFunction(PY_MODULE_TEXT, "inflect_context", Array(sTarget, sBefore, sAfter))
+End Function
+
+Public Function PY_FindSubstr(sHaystack$, sNeedle$) As String
+Attribute PY_FindSubstr.VB_Description = " "
+Attribute PY_FindSubstr.VB_ProcData.VB_Invoke_Func = " \n21"
+ Dim result As Variant:
+ result = AccessPython.CallFunction(PY_MODULE_TEXT, "find_substr", Array(sHaystack, sNeedle))
+ PY_FindSubstr = Fmt("{1},{2}", result(0), result(1))
+End Function
+
+Public Function CC_AbbreviateText(target$) As String
+Attribute CC_AbbreviateText.VB_Description = " "
+Attribute CC_AbbreviateText.VB_ProcData.VB_Invoke_Func = " \n22"
+ CC_AbbreviateText = ApplyCommonAbbreviations(target)
+End Function
+
+Public Function CC_TrimWhitespace(target$) As String
+Attribute CC_TrimWhitespace.VB_Description = " "
+Attribute CC_TrimWhitespace.VB_ProcData.VB_Invoke_Func = " \n22"
+ CC_TrimWhitespace = TrimWhitespace(target)
+End Function
+
+Public Function CC_TrimPunctuation(target$) As String
+Attribute CC_TrimPunctuation.VB_Description = " "
+Attribute CC_TrimPunctuation.VB_ProcData.VB_Invoke_Func = " \n22"
+ CC_TrimPunctuation = TrimEndPunctuation(target)
+End Function
+
+Public Function CC_CutRight(cutWhat$, cutWhere$, Optional keepDelim As Boolean = False) As String
+Attribute CC_CutRight.VB_Description = " \r\ncutWhat - \r\ncutWhere - -\r\n[keepDelim=FALSE] - "
+Attribute CC_CutRight.VB_ProcData.VB_Invoke_Func = " \n22"
+'
+ Dim nPos&: nPos = VBA.InStr(1, cutWhat, cutWhere)
+ If nPos = 0 Then _
+ Exit Function
+ If keepDelim Then
+ CC_CutRight = VBA.Right(cutWhat, VBA.Len(cutWhat) - nPos + 1)
+ Else
+ CC_CutRight = VBA.Right(cutWhat, VBA.Len(cutWhat) - nPos + 1 - VBA.Len(cutWhere))
+ End If
+End Function
+
+Public Function CC_CutLeft(cutWhat$, cutWhere$) As String
+Attribute CC_CutLeft.VB_Description = " \r\ncutWhat - \r\ncutWhere - -"
+Attribute CC_CutLeft.VB_ProcData.VB_Invoke_Func = " \n22"
+'
+ CC_CutLeft = cutWhat
+ Dim nPos&: nPos = VBA.InStr(1, cutWhat, cutWhere)
+ If nPos = 0 Then _
+ Exit Function
+ CC_CutLeft = VBA.Left(cutWhat, nPos - 1)
+End Function
+
+Public Function CC_CountColor(rData As Excel.Range, rCriteria As Excel.Range) As Long
+Attribute CC_CountColor.VB_Description = " \r\nrData - \r\nrCriteria - , "
+Attribute CC_CountColor.VB_ProcData.VB_Invoke_Func = " \n22"
+ Dim aCell As Excel.Range
+ Dim xcolor&: xcolor = rCriteria.Interior.ColorIndex
+ For Each aCell In rData
+ If aCell.Interior.ColorIndex = xcolor Then _
+ CC_CountColor = CC_CountColor + 1
+ Next aCell
+End Function
+
+Public Function CC_FileMD5(sPath$) As String
+Attribute CC_FileMD5.VB_Description = " - MD5"
+Attribute CC_FileMD5.VB_ProcData.VB_Invoke_Func = " \n22"
+ CC_FileMD5 = FileToMD5(sPath)
+ If CC_FileMD5 = vbNullString Then _
+ CC_FileMD5 = "File not found"
+End Function
+
+Public Function CC_FileSHA1(sPath$) As String
+Attribute CC_FileSHA1.VB_Description = " - SAH1"
+Attribute CC_FileSHA1.VB_ProcData.VB_Invoke_Func = " \n22"
+ CC_FileSHA1 = FileToSHA1(sPath)
+ If CC_FileSHA1 = vbNullString Then _
+ CC_FileSHA1 = "File not found"
+End Function
+
+Public Function CC_ExtactFileName(sPath$) As String
+Attribute CC_ExtactFileName.VB_Description = " "
+Attribute CC_ExtactFileName.VB_ProcData.VB_Invoke_Func = " \n22"
+ Dim fso As New Scripting.FileSystemObject
+ CC_ExtactFileName = fso.GetFileName(sPath)
+End Function
+
+Public Function CC_ExtactFileNameText(sPath$) As String
+Attribute CC_ExtactFileNameText.VB_Description = " "
+Attribute CC_ExtactFileNameText.VB_ProcData.VB_Invoke_Func = " \n22"
+ Dim fso As New Scripting.FileSystemObject
+ CC_ExtactFileNameText = fso.GetBaseName(sPath)
+End Function
+
+Public Function CC_ExtactFileExtension(sPath$) As String
+Attribute CC_ExtactFileExtension.VB_Description = " "
+Attribute CC_ExtactFileExtension.VB_ProcData.VB_Invoke_Func = " \n22"
+ Dim fso As New Scripting.FileSystemObject
+ CC_ExtactFileExtension = fso.GetExtensionName(sPath)
+End Function
+
+Public Function CC_ExtactFolderName(sPath$) As String
+Attribute CC_ExtactFolderName.VB_Description = " , "
+Attribute CC_ExtactFolderName.VB_ProcData.VB_Invoke_Func = " \n22"
+ Dim fso As New Scripting.FileSystemObject
+ CC_ExtactFolderName = fso.GetParentFolderName(sPath)
+End Function
+
+Public Function CC_HyperlinkToString(aCell As Excel.Range) As String
+Attribute CC_HyperlinkToString.VB_Description = " "
+Attribute CC_HyperlinkToString.VB_ProcData.VB_Invoke_Func = " \n22"
+ If aCell.Hyperlinks.Count > 0 Then
+ With aCell.Hyperlinks(1)
+ CC_HyperlinkToString = .Address
+ If .SubAddress <> vbNullString Then _
+ CC_HyperlinkToString = CC_HyperlinkToString + "#" + .SubAddress
+ End With
+ End If
+End Function
+
+Public Function CC_SubstituteWhitespace(target$) As String
+Attribute CC_SubstituteWhitespace.VB_Description = " . "
+Attribute CC_SubstituteWhitespace.VB_ProcData.VB_Invoke_Func = " \n22"
+ CC_SubstituteWhitespace = SubstituteWhitespace(target)
+End Function
+
+Public Function CC_MatchCount(target$, iMatch$) As Long
+Attribute CC_MatchCount.VB_Description = " "
+Attribute CC_MatchCount.VB_ProcData.VB_Invoke_Func = " \n22"
+ CC_MatchCount = (VBA.Len(target) - VBA.Len(VBA.Replace(target, iMatch, "", Compare:=vbTextCompare))) / VBA.Len(iMatch)
+End Function
+
+Public Function CC_MatchMultiple(target$, iMatchList As Excel.Range, Optional nMode As TMatchMode = T_MM_DEFAULT) As String
+Attribute CC_MatchMultiple.VB_Description = " , \r\ntarget - \r\niMatchList - \r\n[nMode=1] - \r\n1 - ( ) - \r\n2 - \r\n3 - \r\n4 - "
+Attribute CC_MatchMultiple.VB_ProcData.VB_Invoke_Func = " \n22"
+ Dim aCell As Excel.Range
+ Dim sMatch$
+ Dim sTarget$: sTarget = ApplyMatchMode(target, nMode)
+ For Each aCell In iMatchList
+ Dim sText$: sText = ApplyMatchMode(aCell.Text, nMode)
+ If VBA.InStr(1, sTarget, sText, vbTextCompare) <> 0 Then
+ If sMatch <> vbNullString Then _
+ sMatch = sMatch & ";"
+ sMatch = sMatch & aCell
+ End If
+ Next aCell
+ CC_MatchMultiple = sMatch
+End Function
+
+Public Function CC_LookupSubstr(sSearch$, iData As Excel.Range, nColumn&) As Variant
+Attribute CC_LookupSubstr.VB_Description = " (HLOOKUP), , "
+Attribute CC_LookupSubstr.VB_ProcData.VB_Invoke_Func = " \n22"
+ If nColumn > iData.Columns.Count Then
+ CC_LookupSubstr = CVErr(xlErrValue)
+ Exit Function
+ End If
+
+ Dim aCell As Excel.Range
+ Dim nBlank&: nBlank = 0
+ For Each aCell In iData.Columns(1).Cells
+ Dim sText$: sText = aCell.Text
+ If sText = "" Then
+ nBlank = nBlank + 1
+ If nBlank > BLANKS_LIMIT Then _
+ Exit Function
+ Else
+ nBlank = 0
+ End If
+
+ If VBA.InStr(1, sText, sSearch, vbTextCompare) <> 0 Then
+ CC_LookupSubstr = aCell.Offset(0, nColumn - 1).Text
+ Exit Function
+ End If
+ Next aCell
+End Function
+
+Public Function CC_LongestDuplicateSuffix(iData As Excel.Range, Optional nMaxLen& = 1000) As String
+Attribute CC_LongestDuplicateSuffix.VB_Description = " , 2 "
+Attribute CC_LongestDuplicateSuffix.VB_ProcData.VB_Invoke_Func = " \n22"
+ Dim arrValue As Variant
+ arrValue = iData.Value
+ If ArraySize(arrValue, 2) <> 1 Then
+ CC_LongestDuplicateSuffix = CVErr(xlErrValue)
+ Exit Function
+ End If
+ If ArraySize(arrValue, 1) = 1 Then
+ CC_LongestDuplicateSuffix = ""
+ Exit Function
+ End If
+
+ Dim sInputs() As String: ReDim sInputs(1 To UBound(arrValue))
+ Dim nLens() As Long: ReDim nLens(1 To UBound(arrValue))
+ Dim nItem&
+ Dim nOut&: nOut = 1
+ Dim sCurrent$
+ Dim nCurrentLen&: nCurrentLen = 0
+ For nItem = 1 To UBound(arrValue)
+ sInputs(nOut) = VBA.Right$(CStr(arrValue(nItem, 1)), nMaxLen)
+ nLens(nOut) = VBA.Len(sInputs(nOut))
+ If nLens(nOut) <= nCurrentLen Then _
+ GoTo NEXT_ITEM
+ If nOut = 1 Then
+ nOut = nOut + 1
+ GoTo NEXT_ITEM
+ End If
+
+ Dim nCompare&
+ For nCompare = 1 To nOut - 1 Step 1
+ If nLens(nCompare) <= nCurrentLen Then _
+ GoTo NEXT_COMPARE
+ If VBA.Right$(sInputs(nOut), nCurrentLen + 1) <> VBA.Right$(sInputs(nCompare), nCurrentLen + 1) Then _
+ GoTo NEXT_COMPARE
+
+ Do
+ nCurrentLen = nCurrentLen + 1
+ If nLens(nCompare) <= nCurrentLen Or nLens(nOut) <= nCurrentLen Then _
+ Exit Do
+ If VBA.Mid$(sInputs(nOut), nLens(nOut) - nCurrentLen, 1) <> VBA.Mid$(sInputs(nCompare), nLens(nCompare) - nCurrentLen, 1) Then _
+ Exit Do
+ Loop
+
+ sCurrent = VBA.Right$(sInputs(nOut), nCurrentLen)
+NEXT_COMPARE:
+ Next nCompare
+
+ nOut = nOut + 1
+NEXT_ITEM:
+ Next nItem
+
+ CC_LongestDuplicateSuffix = sCurrent
+End Function
+
+Public Function CC_LongestDuplicatePrefix(iData As Excel.Range, Optional nMaxLen& = 1000) As String
+Attribute CC_LongestDuplicatePrefix.VB_Description = " , 2 "
+Attribute CC_LongestDuplicatePrefix.VB_ProcData.VB_Invoke_Func = " \n22"
+ Dim arrValue As Variant
+ arrValue = iData.Value
+ If ArraySize(arrValue, 2) <> 1 Then
+ CC_LongestDuplicatePrefix = CVErr(xlErrValue)
+ Exit Function
+ End If
+ If ArraySize(arrValue, 1) = 1 Then
+ CC_LongestDuplicatePrefix = ""
+ Exit Function
+ End If
+
+ Dim sInputs() As String: ReDim sInputs(1 To UBound(arrValue))
+ Dim nLens() As Long: ReDim nLens(1 To UBound(arrValue))
+ Dim nItem&
+ Dim nOut&: nOut = 1
+ Dim sCurrent$
+ Dim nCurrentLen&: nCurrentLen = 0
+ For nItem = 1 To UBound(arrValue)
+ sInputs(nOut) = VBA.Left$(CStr(arrValue(nItem, 1)), nMaxLen)
+ nLens(nOut) = VBA.Len(sInputs(nOut))
+ If nLens(nOut) <= nCurrentLen Then _
+ GoTo NEXT_ITEM
+ If nOut = 1 Then
+ nOut = nOut + 1
+ GoTo NEXT_ITEM
+ End If
+
+ Dim nCompare&
+ For nCompare = 1 To nOut - 1 Step 1
+ If nLens(nCompare) <= nCurrentLen Then _
+ GoTo NEXT_COMPARE
+ If VBA.Left$(sInputs(nOut), nCurrentLen + 1) <> VBA.Left$(sInputs(nCompare), nCurrentLen + 1) Then _
+ GoTo NEXT_COMPARE
+
+ Do
+ nCurrentLen = nCurrentLen + 1
+ If nLens(nCompare) <= nCurrentLen Or nLens(nOut) <= nCurrentLen Then _
+ Exit Do
+ If VBA.Mid$(sInputs(nOut), nCurrentLen + 1, 1) <> VBA.Mid$(sInputs(nCompare), nCurrentLen + 1, 1) Then _
+ Exit Do
+ Loop
+
+ sCurrent = VBA.Left$(sInputs(nOut), nCurrentLen)
+NEXT_COMPARE:
+ Next nCompare
+
+ nOut = nOut + 1
+NEXT_ITEM:
+ Next nItem
+
+ CC_LongestDuplicatePrefix = sCurrent
+End Function
+
+Public Function CC_SLOW_LongestDuplicateSubstring(iData As Excel.Range) As String
+Attribute CC_SLOW_LongestDuplicateSubstring.VB_Description = " , 2 \r\n! "
+Attribute CC_SLOW_LongestDuplicateSubstring.VB_ProcData.VB_Invoke_Func = " \n22"
+ Dim arrValue As Variant
+ arrValue = iData.Value
+ If ArraySize(arrValue, 2) <> 1 Then
+ CC_SLOW_LongestDuplicateSubstring = "ERR"
+ Exit Function
+ End If
+ If ArraySize(arrValue, 1) = 1 Then
+ CC_SLOW_LongestDuplicateSubstring = ""
+ Exit Function
+ End If
+
+ Dim sInputs() As String: ReDim sInputs(1 To UBound(arrValue))
+ Dim nLens() As Long: ReDim nLens(1 To UBound(arrValue))
+ Dim nItem&
+ For nItem = 1 To UBound(arrValue)
+ sInputs(nItem) = CStr(arrValue(nItem, 1))
+ nLens(nItem) = VBA.Len(sInputs(nItem))
+ Next nItem
+
+ CC_SLOW_LongestDuplicateSubstring = RunLCS(sInputs, nLens)
+End Function
+
+Public Function CC_LookupMulti(iData As Excel.Range, sText$, nResultColumn&) As Variant
+Attribute CC_LookupMulti.VB_Description = " 1 2.\r\n = 3 , 2"
+Attribute CC_LookupMulti.VB_ProcData.VB_Invoke_Func = " \n22"
+ If nResultColumn > iData.Columns.Count Then
+ CC_LookupMulti = CVErr(xlErrValue)
+ Exit Function
+ End If
+
+ Dim aCell As Excel.Range
+ Dim nBlank&: nBlank = 0
+ For Each aCell In iData.Columns(1).Cells
+ Dim sSearch$: sSearch = aCell.Text
+ If sSearch = "" Then
+ nBlank = nBlank + 1
+ If nBlank > BLANKS_LIMIT Then _
+ Exit Function
+ Else
+ nBlank = 0
+ End If
+
+ If VBA.InStr(1, sText, sSearch, vbTextCompare) <> 0 Then
+ CC_LookupMulti = aCell.Offset(0, nResultColumn - 1).Text
+ Exit Function
+ End If
+ Next aCell
+ CC_LookupMulti = ""
+End Function
+
+Public Function CC_LookupMultiCount(iData As Excel.Range, sText$) As Variant
+Attribute CC_LookupMultiCount.VB_Description = " LookupMulti, "
+Attribute CC_LookupMultiCount.VB_ProcData.VB_Invoke_Func = " \n22"
+ Dim aCell As Excel.Range
+ Dim nBlank&: nBlank = 0
+ CC_LookupMultiCount = 0
+ For Each aCell In iData.Columns(1).Cells
+ Dim sSearch$: sSearch = aCell.Text
+ If sSearch = "" Then
+ nBlank = nBlank + 1
+ If nBlank > BLANKS_LIMIT Then _
+ Exit Function
+ Else
+ nBlank = 0
+ End If
+
+ If VBA.InStr(1, sText, sSearch, vbTextCompare) <> 0 Then
+ CC_LookupMultiCount = CC_LookupMultiCount + 1
+ End If
+ Next aCell
+End Function
+
+Public Function CC_LookupMultiAll(iData As Excel.Range, sText$, nResultColumn&) As Variant
+Attribute CC_LookupMultiAll.VB_Description = " LookupMulti, "
+Attribute CC_LookupMultiAll.VB_ProcData.VB_Invoke_Func = " \n22"
+ If nResultColumn > iData.Columns.Count Then
+ CC_LookupMultiAll = CVErr(xlErrValue)
+ Exit Function
+ End If
+
+ Dim aCell As Excel.Range
+ Dim nBlank&: nBlank = 0
+ CC_LookupMultiAll = ""
+ For Each aCell In iData.Columns(1).Cells
+ Dim sSearch$: sSearch = aCell.Text
+ If sSearch = "" Then
+ nBlank = nBlank + 1
+ If nBlank > BLANKS_LIMIT Then _
+ Exit Function
+ Else
+ nBlank = 0
+ End If
+
+ If VBA.InStr(1, sText, sSearch, vbTextCompare) <> 0 Then
+ If CC_LookupMultiAll <> "" Then _
+ CC_LookupMultiAll = CC_LookupMultiAll & ";"
+ CC_LookupMultiAll = CC_LookupMultiAll & aCell.Offset(0, nResultColumn - 1)
+ End If
+ Next aCell
+End Function
+
+' =======
+Private Function UnregisterMacto(sMacro$)
+ On Error Resume Next
+ Call Excel.Application.MacroOptions(Macro:=sMacro, Category:=Empty, Description:=Empty)
+End Function
+
+Private Function ApplyMatchMode(sText$, nMode As TMatchMode) As String
+ Select Case nMode
+ Case T_MM_DEFAULT: ApplyMatchMode = sText
+ Case T_MM_SPACE_LEFT: ApplyMatchMode = " " & sText
+ Case T_MM_SPACE_RIGHT: ApplyMatchMode = sText & " "
+ Case T_MM_SPACE_BOTH: ApplyMatchMode = " " & sText & " "
+ End Select
+End Function
+
+Private Function RunLCS(sInputs() As String, nLens() As Long) As String
+ Dim sCurrent$
+ Dim nCurrentLen&: nCurrentLen = 0
+
+ Dim nSample&
+ For nSample = 1 To UBound(sInputs) - 1 Step 1
+ Dim nSampleLen&: nSampleLen = nLens(nSample)
+ If nSampleLen <= nCurrentLen Then _
+ GoTo NEXT_SAMPLE
+
+ Dim nSubstr&
+ Dim nPos&
+ Dim nCompare&
+ For nSubstr = nSampleLen To nCurrentLen + 1 Step -1
+ For nPos = 1 To nSampleLen - nSubstr + 1 Step 1
+ Dim sSample$: sSample = VBA.Mid$(sInputs(nSample), nPos, nSampleLen)
+ For nCompare = nSample + 1 To UBound(sInputs) Step 1
+ If nLens(nCompare) < nSampleLen Then _
+ GoTo NEXT_COMPARE
+ Dim nFound&: nFound = VBA.InStr(nPos, sInputs(nCompare), sSample, vbTextCompare)
+ If nFound <> 0 Then
+ nCurrentLen = nSubstr
+ sCurrent = sSample
+ GoTo NEXT_SAMPLE
+ End If
+NEXT_COMPARE:
+ Next nCompare
+ Next nPos
+ Next nSubstr
+NEXT_SAMPLE:
+ Next nSample
+
+ RunLCS = sCurrent
+End Function
diff --git a/src/RelocateDlg.frm b/src/RelocateDlg.frm
new file mode 100644
index 0000000..39a932f
--- /dev/null
+++ b/src/RelocateDlg.frm
@@ -0,0 +1,78 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} RelocateDlg
+ Caption = " "
+ ClientHeight = 1740
+ ClientLeft = 120
+ ClientTop = 465
+ ClientWidth = 6840
+ OleObjectBlob = "RelocateDlg.frx":0000
+ StartUpPosition = 1 'CenterOwner
+End
+Attribute VB_Name = "RelocateDlg"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private prefixInit_ As String
+Private fso_ As Scripting.FileSystemObject
+
+Public isCancelled_ As Boolean
+
+Private Sub UserForm_Initialize()
+ isCancelled_ = True
+ Set fso_ = New Scripting.FileSystemObject
+End Sub
+
+Public Function Init(sFilesLocation$)
+ prefixInit_ = sFilesLocation
+End Function
+
+Public Property Get Path() As String
+ Path = TBTargetPath.Text
+End Property
+
+Public Property Get Prefix() As String
+ Prefix = TBPrefix.Text
+End Property
+
+' ====== Internal API
+Private Sub OkBtn_Click()
+ If Not ValidateData Then
+ Call UserInteraction.ShowMessage(EM_RELOCATE_DATA_FAIL)
+ Else
+ isCancelled_ = False
+ Call Me.Hide
+ End If
+End Sub
+
+Private Sub CancelBtn_Click()
+ isCancelled_ = True
+ Call Me.Hide
+End Sub
+
+Private Sub BtnPrefix_Click()
+ Dim sFolder$: sFolder = UserInteraction.PromptFolder(prefixInit_ & "\")
+ If sFolder <> vbNullString Then _
+ TBPrefix.Text = sFolder
+End Sub
+
+Private Sub BtnTargetPath_Click()
+ Dim sFolder$: sFolder = UserInteraction.PromptFolder(ThisWorkbook.Path & "\")
+ If sFolder <> vbNullString Then _
+ TBTargetPath.Text = sFolder
+End Sub
+
+' =====
+Private Function ValidateData() As Boolean
+ ValidateData = False
+
+ Dim sPath$: sPath = Path
+ If sPath = vbNullString Then _
+ Exit Function
+ If Not fso_.FolderExists(sPath) Then _
+ Exit Function
+
+ ValidateData = True
+End Function
diff --git a/src/RelocateDlg.frx b/src/RelocateDlg.frx
new file mode 100644
index 0000000..4162336
Binary files /dev/null and b/src/RelocateDlg.frx differ
diff --git a/src/SearchDlg.frm b/src/SearchDlg.frm
new file mode 100644
index 0000000..9a871c9
--- /dev/null
+++ b/src/SearchDlg.frm
@@ -0,0 +1,96 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} SearchDlg
+ Caption = " "
+ ClientHeight = 5370
+ ClientLeft = 120
+ ClientTop = 465
+ ClientWidth = 4575
+ OleObjectBlob = "SearchDlg.frx":0000
+ StartUpPosition = 1 'CenterOwner
+End
+Attribute VB_Name = "SearchDlg"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Public isCancelled_ As Boolean
+
+Private dataSource_ As Excel.Workbook
+
+Public Function Init(targetWB As Excel.Workbook)
+ isCancelled_ = True
+ Set dataSource_ = targetWB
+End Function
+
+Public Function ResultParams() As ParametersSearch
+ Set ResultParams = New ParametersSearch
+ With ResultParams
+ .ignoreSmall_ = CBIgnoreWords.Value
+ .partialMatch_ = Not CBFindWhole.Value
+ .normalize_ = CBNormalize.Value
+ .outputText_ = CBOutputText.Value
+ .smallSize_ = TBSymbolLimit.Value
+ Set .searchWhere_ = Excel.Range(TBSearchRange.Text)
+ Set .searchWhat_ = Excel.Range(TBQueryRange.Text)
+ End With
+End Function
+
+Private Sub BtnCancel_Click()
+ isCancelled_ = True
+ Call Me.Hide
+End Sub
+
+Private Sub BtnOK_Click()
+ If Not ValidateData Then
+ Call UserInteraction.ShowMessage(EM_DIALOG_DATA_INVALID)
+ Else
+ isCancelled_ = False
+ Call Me.Hide
+ End If
+End Sub
+
+Private Sub BtnSearchRange_Click()
+ Call Me.Hide
+
+ Dim iRange As Excel.Range
+ On Error Resume Next
+ Set iRange = Excel.Application.InputBox( _
+ Title:=" ", _
+ Prompt:=" , ", _
+ Type:=8)
+ On Error GoTo 0
+
+ If Not iRange Is Nothing Then _
+ TBSearchRange.Text = iRange.Address(External:=True)
+
+ Call Me.Show
+End Sub
+
+Private Sub BtnQueryRange_Click()
+ Call Me.Hide
+
+ Dim iRange As Excel.Range
+ On Error Resume Next
+ Set iRange = Excel.Application.InputBox( _
+ Title:=" ", _
+ Prompt:=" , ", _
+ Type:=8)
+ On Error GoTo 0
+
+ If Not iRange Is Nothing Then _
+ TBQueryRange.Text = iRange.Address(External:=True)
+
+ Call Me.Show
+End Sub
+
+' ========
+Private Function ValidateData() As Boolean
+ ValidateData = False
+ If TBQueryRange.Text = vbNullString Then _
+ Exit Function
+ If TBSearchRange.Text = vbNullString Then _
+ Exit Function
+ ValidateData = True
+End Function
diff --git a/src/SearchDlg.frx b/src/SearchDlg.frx
new file mode 100644
index 0000000..750e3a0
Binary files /dev/null and b/src/SearchDlg.frx differ
diff --git a/src/SearchEngine.cls b/src/SearchEngine.cls
new file mode 100644
index 0000000..35018a9
--- /dev/null
+++ b/src/SearchEngine.cls
@@ -0,0 +1,267 @@
+VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "SearchEngine"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private out_ As Excel.Worksheet
+Private params_ As ParametersSearch
+
+Private queryWords_ As Scripting.Dictionary
+Private queryCount_ As Long
+
+Private foundIDs_() As Collection
+Private wordCounts_() As Long
+
+Private Const PROGRESS_DICTIONARY = 10
+Private Const PROGRESS_SEARCH = 89
+Private Const PROGRESS_RESULTS = 1
+
+Private Const MAX_COLUMNS = 250
+
+' _SR_ - search results
+Private Enum SearchResultStruct
+ [_First] = 1
+
+ S_SR_INPUT = 1
+ S_SR_COUNT = 2
+ S_SR_DATA = 3
+
+ [_Last] = 3
+End Enum
+
+Public Function Init(iOut As Excel.Worksheet, params As ParametersSearch)
+ Set out_ = iOut
+ Set params_ = params
+ If Not params_.ignoreSmall_ Then _
+ params_.smallSize_ = 0
+End Function
+
+Public Function Execute()
+ Call CSE_ProgressBar.Init(" ", maxVal:=100, canInterrupt:=True)
+ Call CSE_ProgressBar.ShowModeless
+
+ CSE_ProgressBar.Description = " ..."
+ Call PrepareIndexDictionary
+
+ CSE_ProgressBar.Description = "..."
+ Call ExecuteSearch
+
+ CSE_ProgressBar.Description = " ..."
+ Call FinalizeResults
+ Call CSE_ProgressBar.IncrementA(PROGRESS_RESULTS)
+
+ Call Unload(CSE_ProgressBar)
+End Function
+
+' ========
+Private Function PrepareIndexDictionary()
+ queryCount_ = CountNonEmpty(params_.searchWhat_)
+ Call ResetWordCounts
+ Call CSE_ProgressBar.InitSecondBar(maxVal:=queryCount_)
+
+ Set queryWords_ = New Scripting.Dictionary
+ Dim nItem&: nItem = 1
+ Dim iCell As Excel.Range
+ Dim iWords As Collection
+ For Each iCell In params_.searchWhat_
+ Set iWords = ExtractWords(iCell.Text)
+ wordCounts_(nItem) = iWords.Count
+
+ Dim iWord As Variant
+ For Each iWord In iWords
+ If params_.normalize_ Then _
+ iWord = PY_Normalize(CStr(iWord))
+ If Not queryWords_.Exists(CStr(iWord)) Then _
+ Set queryWords_(CStr(iWord)) = New Collection
+ On Error Resume Next
+ Call queryWords_(CStr(iWord)).Add(nItem, CStr(nItem))
+ On Error GoTo 0
+ Next iWord
+
+ If nItem = queryCount_ Then _
+ Exit For
+ nItem = nItem + 1
+ Call CSE_ProgressBar.IncrementB
+ Call CSE_ProgressBar.SetA(PROGRESS_DICTIONARY * nItem / queryCount_)
+ Next iCell
+
+ Call CSE_ProgressBar.HideSecondBar
+End Function
+
+Private Function ExecuteSearch()
+ Dim nTextCount&: nTextCount = CountNonEmpty(params_.searchWhere_)
+ Call ResetFoundIDs
+ Call CSE_ProgressBar.InitSecondBar(maxVal:=nTextCount)
+
+ Dim nItem&: nItem = 1
+ Dim iCell As Excel.Range
+ Dim iWords As Collection
+ Dim iCounts As Scripting.Dictionary
+ Dim vQueryID As Variant
+ Dim iWord As Variant
+
+ For Each iCell In params_.searchWhere_
+ Set iCounts = New Scripting.Dictionary
+ Set iWords = ExtractWords(iCell.Text)
+
+ For Each iWord In iWords
+ If params_.normalize_ Then _
+ iWord = PY_Normalize(CStr(iWord))
+ If queryWords_.Exists(CStr(iWord)) Then
+ For Each vQueryID In queryWords_(CStr(iWord))
+ If Not iCounts.Exists(CStr(vQueryID)) Then _
+ iCounts(CStr(vQueryID)) = 0
+ iCounts(CStr(vQueryID)) = iCounts(CStr(vQueryID)) + 1
+ Next vQueryID
+ End If
+ Next iWord
+
+ For Each vQueryID In iCounts.Keys
+ If params_.partialMatch_ Or wordCounts_(CLng(vQueryID)) <= iCounts(vQueryID) Then _
+ Call foundIDs_(CLng(vQueryID)).Add(nItem, CStr(nItem))
+ Next vQueryID
+
+ If CSE_ProgressBar.Interrupted Or nItem = nTextCount Then _
+ Exit For
+ nItem = nItem + 1
+ Call CSE_ProgressBar.IncrementB
+ Call CSE_ProgressBar.SetA(PROGRESS_DICTIONARY + PROGRESS_SEARCH * nItem / nTextCount)
+ Next iCell
+
+ Call CSE_ProgressBar.HideSecondBar
+End Function
+
+Private Function FinalizeResults()
+ Call CSE_ProgressBar.InitSecondBar(maxVal:=queryCount_)
+
+ Dim nItem&: nItem = 1
+ Dim nCount&
+
+ Dim iCell As Excel.Range
+ For Each iCell In params_.searchWhat_
+ nCount = foundIDs_(nItem).Count
+ out_.Cells(nItem, S_SR_INPUT) = iCell
+ out_.Cells(nItem, S_SR_COUNT) = foundIDs_(nItem).Count
+ If nCount = 0 Then _
+ GoTo NEXT_ITEM
+
+ If params_.outputText_ Then
+ Call OutputWords(nItem)
+ Else
+ out_.Cells(nItem, 3) = ListIDs(nItem)
+ End If
+
+NEXT_ITEM:
+ If nItem = queryCount_ Then _
+ Exit For
+ nItem = nItem + 1
+ Call CSE_ProgressBar.IncrementB
+ Next iCell
+
+ Call CSE_ProgressBar.HideSecondBar
+End Function
+
+Private Function ExtractWords(sText$) As Collection
+ Dim iWords As New Collection
+ Dim nStart&: nStart = 1
+ Dim nLen&: nLen = VBA.Len(sText)
+ Dim nCur&: nCur = nStart
+ Do While nCur <= nLen
+ If IsDelim(VBA.Mid$(sText, nCur, 1)) Then
+ If nCur > nStart And nCur - nStart >= params_.smallSize_ Then _
+ Call iWords.Add(VBA.Mid$(sText, nStart, nCur - nStart))
+ nStart = nCur + 1
+ End If
+ nCur = nCur + 1
+ Loop
+
+ If nCur > nStart And nCur - nStart >= params_.smallSize_ Then _
+ Call iWords.Add(VBA.Mid$(sText, nStart, nCur - nStart))
+ Set ExtractWords = iWords
+End Function
+
+Private Function ResetFoundIDs()
+ ReDim foundIDs_(1 To queryCount_)
+ Dim nItem&
+ For nItem = 1 To queryCount_ Step 1
+ Set foundIDs_(nItem) = New Collection
+ Next nItem
+End Function
+
+Private Function ResetWordCounts()
+ ReDim wordCounts_(1 To queryCount_)
+End Function
+
+Private Function CountNonEmpty(target As Excel.Range) As Long
+ Dim emptyIndex&: emptyIndex = XLFirstEmptyCell(target)
+ If emptyIndex = -1 Then
+ CountNonEmpty = target.Count
+ Else
+ CountNonEmpty = emptyIndex - 1
+ End If
+End Function
+
+Private Function ListIDs(nItem&) As String
+ ListIDs = ""
+ Dim vID As Variant
+ For Each vID In foundIDs_(nItem)
+ If ListIDs <> "" Then _
+ ListIDs = ListIDs & ", "
+ ListIDs = ListIDs & CStr(vID)
+ Next vID
+End Function
+
+Private Function OutputWords(nItem&)
+ Dim nColumn&: nColumn = S_SR_DATA
+ Dim vID As Variant
+ For Each vID In foundIDs_(nItem)
+ out_.Cells(nItem, nColumn) = params_.searchWhere_(CLng(vID))
+ nColumn = nColumn + 1
+ If nColumn >= MAX_COLUMNS Then _
+ Exit For
+ Next vID
+End Function
+
+Private Function IsDelim(sSymbol$) As Boolean
+ IsDelim = True
+ If sSymbol = Chr(13) Then
+ Exit Function
+ ElseIf sSymbol = Chr(10) Then
+ Exit Function
+ ElseIf sSymbol = "," Then
+ Exit Function
+ ElseIf sSymbol = ChrW(&H2013) Then _
+ Exit Function
+ ElseIf sSymbol = ChrW(&H2012) Then _
+ Exit Function
+ ElseIf sSymbol = ChrW(&H2010) Then _
+ Exit Function
+ ElseIf sSymbol = ";" Then
+ Exit Function
+ ElseIf sSymbol = " " Then
+ Exit Function
+ ElseIf sSymbol = "!" Then
+ Exit Function
+ ElseIf sSymbol = ":" Then
+ Exit Function
+ ElseIf sSymbol = "?" Then
+ Exit Function
+ ElseIf sSymbol = """" Then
+ Exit Function
+ ElseIf sSymbol = ")" Then
+ Exit Function
+ ElseIf sSymbol = "(" Then
+ Exit Function
+ ElseIf sSymbol = "Chr(85)" Then
+ Exit Function
+ End If
+ IsDelim = False
+End Function
+
+
diff --git a/src/WordDlg.frm b/src/WordDlg.frm
new file mode 100644
index 0000000..7323eb1
--- /dev/null
+++ b/src/WordDlg.frm
@@ -0,0 +1,55 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} WordDlg
+ Caption = " "
+ ClientHeight = 3300
+ ClientLeft = 120
+ ClientTop = 465
+ ClientWidth = 4770
+ OleObjectBlob = "WordDlg.frx":0000
+ StartUpPosition = 1 'CenterOwner
+End
+Attribute VB_Name = "WordDlg"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private bUpdate_ As Boolean
+Public isCanceled_ As Boolean
+
+Private Sub UserForm_Initialize()
+ isCanceled_ = True
+ Call PositionInMiddle(Me)
+End Sub
+
+Public Function Init(opts As AddinOptions)
+ isCanceled_ = True
+ CBConcept.Value = opts.data_.Item(T_WA_CONCEPT)
+ CBNpa.Value = opts.data_.Item(T_WA_NPA)
+ CBMarkup.Value = opts.data_.Item(T_WA_MARKUP)
+ CBParsers.Value = opts.data_.Item(T_WA_PARSERS)
+ CBMaket.Value = opts.data_.Item(T_WA_MAKET)
+End Function
+
+Public Function GetResult() As AddinOptions
+ Set GetResult = New AddinOptions
+ With GetResult
+ .data_.Item(T_WA_CONCEPT) = CBConcept.Value
+ .data_.Item(T_WA_NPA) = CBNpa.Value
+ .data_.Item(T_WA_MARKUP) = CBMarkup.Value
+ .data_.Item(T_WA_PARSERS) = CBParsers.Value
+ .data_.Item(T_WA_MAKET) = CBMaket.Value
+ End With
+End Function
+
+' =======
+Private Sub BtnCancel_Click()
+ isCanceled_ = True
+ Call Me.Hide
+End Sub
+
+Private Sub BtnOK_Click()
+ isCanceled_ = False
+ Call Me.Hide
+End Sub
diff --git a/src/WordDlg.frx b/src/WordDlg.frx
new file mode 100644
index 0000000..6d444ed
Binary files /dev/null and b/src/WordDlg.frx differ
diff --git a/src/z_UIMessages.bas b/src/z_UIMessages.bas
new file mode 100644
index 0000000..5e157d8
--- /dev/null
+++ b/src/z_UIMessages.bas
@@ -0,0 +1,84 @@
+Attribute VB_Name = "z_UIMessages"
+' Messaging module
+Option Private Module
+Option Explicit
+
+Public Enum MsgCode
+ EM_PROJECTS_EMPTY
+ EM_SELECTION_NO_HYPERLINKS
+ EM_SELECTION_EMPTY
+ EM_RELOCATE_DATA_FAIL
+ EM_WORD_IS_OPEN
+ EM_CORE_UPDATE_FAILED
+ EM_WORD_ADDINS_FAILED
+ EM_TEMPLATES_FAILED
+ EM_DIALOG_DATA_INVALID
+
+ IM_LINKS_VALIDATION
+ IM_LINKS_SERVER
+ IM_LINKS_SCAN_OK
+ IM_LINKS_RELOCATE_OK
+ IM_CONCEPT_UPDATE_OK
+ IM_WORD_ADDINS_OK
+ IM_TEMPLATES_OK
+ IM_LINKS_COPY_OK
+ IM_SEARCH_OK
+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_PROJECTS_EMPTY: Call MsgBox(" ", vbExclamation)
+ Case EM_SELECTION_NO_HYPERLINKS: Call MsgBox(" ", vbExclamation)
+ Case EM_SELECTION_EMPTY: Call MsgBox(" ", vbExclamation)
+ Case EM_RELOCATE_DATA_FAIL: Call MsgBox(" ", vbExclamation)
+ Case EM_WORD_IS_OPEN: Call MsgBox(" Word ", vbExclamation)
+ Case EM_CORE_UPDATE_FAILED: Call MsgBox(" ." & vbNewLine _
+ & " VPN, (\\fs1.concept.ru)" & vbNewLine _
+ & " Excel dll", vbExclamation)
+ Case EM_WORD_ADDINS_FAILED: Call MsgBox(" . \\fs1.concept.ru", vbExclamation)
+ Case EM_TEMPLATES_FAILED: Call MsgBox(" ", vbExclamation)
+ Case EM_DIALOG_DATA_INVALID: Call MsgBox(" ", vbExclamation)
+
+ Case IM_LINKS_VALIDATION: Call MsgBox(Fmt(" : {1}/{2}", unwrapped), vbInformation)
+ Case IM_LINKS_SCAN_OK: Call MsgBox(Fmt(" : {1}/{2}", unwrapped), vbInformation)
+ Case IM_LINKS_RELOCATE_OK: Call MsgBox(Fmt(" : {1}/{2}", unwrapped), vbInformation)
+ Case IM_LINKS_SERVER: Call MsgBox(Fmt(" : {1}/{2}", unwrapped), vbInformation)
+ Case IM_CONCEPT_UPDATE_OK: Call MsgBox(" ", vbInformation)
+ Case IM_WORD_ADDINS_OK: Call MsgBox(" ", vbInformation)
+ Case IM_TEMPLATES_OK: Call MsgBox(" ", vbInformation)
+ Case IM_LINKS_COPY_OK: Call MsgBox(Fmt(" : {1}/{2}", unwrapped), vbInformation)
+ Case IM_SEARCH_OK: Call MsgBox(" ", vbInformation)
+
+ 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/z_UIRibbon.bas b/src/z_UIRibbon.bas
new file mode 100644
index 0000000..5b22160
--- /dev/null
+++ b/src/z_UIRibbon.bas
@@ -0,0 +1,42 @@
+Attribute VB_Name = "z_UIRibbon"
+Option Explicit
+Option Private Module
+
+Public Sub CC_OnRibbonBtn(iControl As IRibbonControl)
+ Select Case iControl.ID
+ Case "CCGroupByRank": Call CC_RunGroupByRank
+ Case "CCGroupByID": Call CC_RunGroupByID
+
+ Case "CCTrimCells": Call CC_RunTrimCells
+ Case "CCTrimPunctuation": Call CC_RunTrimPunctuation
+ Case "CCSubstituteWhitespace": Call CC_RunSubstituteWhitespace
+ Case "CCSplitText": Call CC_RunSplitText
+ Case "CCClearFormatting": Call CC_RunClearFormatting
+
+ Case "CCAnalyseSearch": Call CC_RunAnalyseSearch
+
+ Case "CCLinksCreate": Call CC_RunLinksCreate
+ Case "CCLinksScan": Call CC_RunLinksScan
+ Case "CCLinksValidate": Call CC_RunLinksValidate
+ Case "CCLinksCopyFiles": Call CC_RunLinksCopyFiles
+ Case "CCLinksRelocate": Call CC_RunLinksRelocate
+ Case "CCLinksServer": Call CC_RunLinksServer
+ Case "CCLinksPrint": Call CC_RunLinksPrint
+
+ Case "CCListIncome": Call CC_RunListIncome
+ Case "CCListOutcome": Call CC_RunListOutcome
+ Case "CCListLeads": Call CC_RunListLeads
+ Case "CCListTentative": Call CC_RunListTentative
+
+ Case "CCConceptStatus": Call CC_RunConceptStatus
+ Case "CCUpdateConcept": Call CC_RunUpdateConceptCore
+ Case "CCConfig": Call CC_RunConfig
+ Case "CCWordAddin": Call CC_RunWordAddin
+ Case "CCUpdateTemplates": Call CC_RunUpdateTemplates
+ Case "CCAppdata": Call CC_RunAppdata
+ Case "CCDescriptionUDF": Call CC_RunDescriptionUDF
+
+ Case "CCxlHelp": Call CC_RunHelp
+ End Select
+End Sub
+
diff --git a/ui/.rels b/ui/.rels
new file mode 100644
index 0000000..3107a8e
--- /dev/null
+++ b/ui/.rels
@@ -0,0 +1,2 @@
+
+
\ No newline at end of file
diff --git a/ui/customUI.xml b/ui/customUI.xml
new file mode 100644
index 0000000..85d790d
--- /dev/null
+++ b/ui/customUI.xml
@@ -0,0 +1,140 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
\ No newline at end of file