Initial commit

VBAMake.txt

@@ -0,0 +1,52 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact_home, source_home
+
+id = Concept-Markup
+name = Концепт-Разметка
+description = Модуль разметки текстов в Word
+artifact_home = Концепт-Разметка
+source_home = Concept-Markup
+install_home = \\fs1.concept.ru\projects\10 Автоматизация деятельности\01 Высокие технологии\Концепт-Разметка
+
+%%
+# === Build section ===
+# Available commands:
+#   build LOCAL_MANIFEST
+#   copy LOCAL_SOURCE -> [LOCAL_ARTIFACT]
+#   save_as LOCAL_ARTIFACT -> LOCAL_ARTIFACT
+#   run LOCAL_SOURCE.bat
+
+copy test
+
+build script\markupManifest.txt
+build script\aggregatorManifest.txt
+build script\interviewManifest.txt
+
+copy distr\Надстройка\Install.bat -> Надстройка\Install.bat
+copy distr\Надстройка\Uninstall.bat -> Надстройка\Uninstall.bat
+copy distr\!!Листовка.docx
+copy distr\!Руководство пользователя.docx
+copy distr\Разметка
+
+%%
+# === Install section ==
+# Available commands:
+#	install LOCAL_ARTIFACT -> [INSTALL_PATH]
+#	add_template LOCAL_ARTIFACT -> [LOCAL_TEMPLATE]
+#   run LOCAL_ARTIFACT.bat <- [PARAMETERS]
+#	run APPLICATION <- [PARAMETERS]
+
+install Утилиты\!Агрегатор расчисток.xlsm
+install Утилиты\!Сборка расчисток интервью.xlsm
+install Надстройка\Install.bat -> Надстройка\Install.bat
+install Надстройка\Uninstall.bat -> Надстройка\Uninstall.bat
+install Надстройка\MARKUP.dotm -> Надстройка\MARKUP.dotm
+install Разметка
+
+install !!Листовка.docx
+install !Руководство пользователя.docx
+
+install Надстройка\MARKUP.dotm -> \\fs1.concept.ru\Exchange\ConceptDistr\data\Add-ins\Word\MARKUP.dotm
+add_template Разметка

VERSION

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

distr/Надстройка/Install.bat

@@ -0,0 +1,3 @@
+@echo off
+
+copy "MARKUP.dotm" "%APPDATA%\Microsoft\Word\STARTUP\"

distr/Надстройка/Uninstall.bat

@@ -0,0 +1,3 @@
+@echo off
+
+del "%APPDATA%\Microsoft\Word\STARTUP\MARKUP.dotm"

script/aggregatorManifest.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
+
+api
+	ex_WinAPI.bas
+	ex_Metadata.bas
+	API_Path.cls
+	API_WordWrapper.cls
+	API_XLWrapper.cls
+	API_UserInteraction.cls
+	
+utility
+	ex_VBA.bas
+	ex_Collection.bas
+	ex_DataPreparation.bas
+	CDS_Interval.cls
+	CDS_CompoundIntervals.cls
+	
+excel
+	ex_Excel.bas
+	
+word
+	ex_Word.bas
+	
+ui
+	CSE_ProgressBar.frm
+	
+dev
+	DevTester.bas
+
+%%
+# === Source Code Section ==
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SourceHome path
+
+src
+	common
+		MU_Declarations.bas
+		
+		MarkupAPI.cls
+		InfoCategory.cls
+		InfoConfig.cls
+		InfoFormat.cls
+		InfoDocument.cls
+		
+		ItemConfigDescriptor.cls
+		ItemFragment.cls
+		
+		IteratorFormat.cls
+		IteratorStyle.cls
+		
+	aggregator
+		MUD_ImportWord.frm
+		
+		DevHelper.bas
+		Declarations.bas
+		Main.bas
+		MainImpl.bas
+		z_UIRibbon.bas
+		z_UIMessages.bas
+		
+		DB_Markup.cls
+		ItemSource.cls
+		ItemLink.cls
+		
+	test
+		s_DBMarkup.cls
+
+%%
+# ===== UI Section =======
+# Pairs of path to UI elements, use " -> " delimiter
+# First component is a path relative to SourceHome\ui folders
+# Second component is internal path inside project file
+
+aggregator\.rels -> _rels\.rels
+aggregator\customUI.xml -> customUI\customUI.xml
+
+%%
+# === References Section ===
+# List dependencies in one of the formats
+# global : GLOBAL_NAME
+# guid : {REGISTERED_GUID}
+# file : PATH_TO_LIBRARY
+
+global : Shell32
+global : Scripting
+global : Word
+global : MSForms

script/interviewManifest.txt

@@ -0,0 +1,55 @@
+# == 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
+
+api
+	ex_WinAPI.bas
+	API_XLWrapper.cls
+	API_UserInteraction.cls
+	
+utility
+	ex_VBA.bas
+	ex_Collection.bas
+
+%%
+# === Source Code Section ==
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SourceHome path
+
+src
+	utils
+		interview
+			Declarations.bas
+			Main.bas
+			MainImpl.bas
+			z_UIMessages.bas
+			
+%%
+# ===== 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
+
+
+
+%%
+# === References Section ===
+# List dependencies in one of the formats
+# global : GLOBAL_NAME
+# guid : {REGISTERED_GUID}
+# file : PATH_TO_LIBRARY
+
+global : Shell32
+global : Scripting
+global : MSForms

script/markupManifest.txt

@@ -0,0 +1,98 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact
+
+name = MARKUP.dotm
+artifact = Надстройка\MARKUP.dotm
+
+%%
+# === Imports Section ===
+# Hierarchy of folders and files
+# Use Tabulator to mark next level in hierarchy
+# All folders are nested into SharedHome path
+
+api
+	ex_WinAPI.bas
+	ex_Metadata.bas
+	
+	API_Path.cls
+	API_WordWrapper.cls
+	API_XLWrapper.cls
+	API_Ribbon.cls
+	API_UserInteraction.cls
+	
+utility
+	ex_VBA.bas
+	ex_DataPreparation.bas
+	ex_Collection.bas
+	CDS_Interval.cls
+	CDS_CompoundIntervals.cls
+	
+word
+	ex_Word.bas
+	
+dev
+	DevTester.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
+	common
+		MU_Declarations.bas
+		
+		MarkupAPI.cls
+		InfoCategory.cls
+		InfoConfig.cls
+		InfoFormat.cls
+		InfoDocument.cls
+		
+		ItemConfigDescriptor.cls
+		ItemFragment.cls
+		
+		IteratorFormat.cls
+		IteratorStyle.cls
+
+	markup
+		DevHelper.bas
+		Declarations.bas
+		Main.bas
+		MainImpl.bas
+		z_UIRibbon.bas
+		z_UIMessages.bas
+			
+	test
+		s_Category.cls
+		s_Config.cls
+		s_Format.cls
+		s_MarkupAPI.cls
+		s_WordDocument.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
+
+markup\.rels -> _rels\.rels
+markup\customUI.xml -> customUI\customUI.xml
+markup\customizations.xml -> word\customizations.xml
+
+%%
+# === References Section ===
+# List dependencies in one of the formats
+# global : GLOBAL_NAME
+# guid : {REGISTERED_GUID}
+# file : PATH_TO_LIBRARY
+
+global : Shell32
+global : Scripting
+global : Excel
+global : MSForms

src/aggregator/DB_Markup.cls

@@ -0,0 +1,166 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "DB_Markup"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private data_ As Excel.Worksheet
+Private sources_ As Excel.Worksheet
+
+Public Function Init(iData As Excel.Worksheet, iSources As Excel.Worksheet)
+  Set data_ = iData
+  Set sources_ = iSources
+End Function
+
+Public Function RemoveAll()
+  Call data_.UsedRange.Offset(1, 0).ClearContents
+  Call sources_.UsedRange.Offset(1, 0).ClearContents
+End Function
+
+Public Function GetLinkFor(nDataRow&) As ItemLink
+  If data_.Cells(nDataRow, S_DATA_ID) = vbNullString Then _
+    Exit Function
+  Dim sPath$: sPath = FindSourcePath(data_.Cells(nDataRow, S_DATA_SOURCE))
+  If sPath = vbNullString Then _
+    Exit Function
+  
+  Dim iLink As New ItemLink
+  iLink.start_ = data_.Cells(nDataRow, S_DATA_START)
+  iLink.finish_ = data_.Cells(nDataRow, S_DATA_FINISH)
+  iLink.path_ = sPath
+  
+  Set GetLinkFor = iLink
+End Function
+
+Public Function ImportFromExcel(iSource As Excel.Worksheet) As Boolean
+  ImportFromExcel = False
+  
+  Dim iPath As New API_Path: Call iPath.FromString(iSource.Cells(FIRST_ROW, S_IN_SOURCE))
+  Dim intSource As ItemSource: Set intSource = PrepareSourceInput(iPath)
+  If intSource Is Nothing Then _
+    Exit Function
+  
+  Dim rowOut&: rowOut = intSource.rowOut_
+  Dim rowIn&: rowIn = FIRST_ROW
+  Do While iSource.Cells(rowIn, S_IN_START) <> vbNullString
+    data_.Cells(rowOut, S_DATA_ID) = intSource.sourceID_ & "-" & VBA.Format(rowIn - 1, "0000")
+    data_.Cells(rowOut, S_DATA_SOURCE) = intSource.sourceID_
+    data_.Cells(rowOut, S_DATA_START) = iSource.Cells(rowIn, S_IN_START)
+    data_.Cells(rowOut, S_DATA_FINISH) = iSource.Cells(rowIn, S_IN_FINISH)
+    data_.Cells(rowOut, S_DATA_TYPE) = iSource.Cells(rowIn, S_IN_TYPE)
+    data_.Cells(rowOut, S_DATA_TEXT) = iSource.Cells(rowIn, S_IN_TEXT)
+    data_.Cells(rowOut, S_DATA_COMMENT) = iSource.Cells(rowIn, S_IN_COMMENT)
+    rowOut = rowOut + 1
+    rowIn = rowIn + 1
+  Loop
+  
+  ImportFromExcel = True
+End Function
+
+Public Function ImportFromWord(iSource As InfoDocument) As Boolean
+  ImportFromWord = False
+  
+  Dim frags As Collection: Set frags = iSource.GetBasicFragmentsCompound()
+  Dim iPath As New API_Path: Call iPath.FromString(iSource.doc_.FullName).GlobalToServer
+  Dim intSource As ItemSource: Set intSource = PrepareSourceInput(iPath)
+  If intSource Is Nothing Then _
+    Exit Function
+    
+  Dim rowOut&: rowOut = intSource.rowOut_
+  Dim rowStart&: rowStart = intSource.rowOut_
+  Dim nItem&: nItem = 1
+  Dim aFrag As ItemFragment
+  For Each aFrag In frags
+    Dim theRange As Word.Range: Set theRange = iSource.doc_.Range(aFrag.start_, aFrag.end_)
+    
+    data_.Cells(rowOut, S_DATA_ID) = intSource.sourceID_ & "-" & VBA.Format(nItem - 1, "0000")
+    data_.Cells(rowOut, S_DATA_SOURCE) = intSource.sourceID_
+    data_.Cells(rowOut, S_DATA_START) = aFrag.start_
+    data_.Cells(rowOut, S_DATA_FINISH) = aFrag.end_
+    data_.Cells(rowOut, S_DATA_TYPE) = aFrag.id_
+    data_.Cells(rowOut, S_DATA_TEXT) = theRange.Text
+    data_.Cells(rowOut, S_DATA_COMMENT) = ExtractCommentText(theRange)
+    
+    nItem = nItem + 1
+    rowOut = rowOut + 1
+  Next aFrag
+  
+  Call data_.Range(data_.Cells(rowStart, S_DATA_ID), data_.Cells(rowOut - 1, S_DATA_COMMENT)).Sort( _
+    Key1:=data_.Cells(rowStart, S_DATA_START), _
+    Order1:=xlAscending, _
+    Key2:=data_.Cells(rowStart, S_DATA_FINISH), _
+    Order2:=xlDescending, _
+    Header:=xlNo)
+  
+  ImportFromWord = True
+End Function
+
+' ======
+Private Function PrepareSourceInput(iPath As API_Path) As ItemSource
+  Dim iSource As New ItemSource
+  Dim nRow&: nRow = FIRST_ROW
+  Dim sPath$: sPath = iPath.Text
+  Do While sources_.Cells(nRow, S_SRC_ID) <> vbNullString
+    If sources_.Cells(nRow, S_SRC_PATH) = sPath Then
+      If Not UserInteraction.AskQuestion(QM_CLEAR_BEFORE_READD) Then _
+        Exit Function
+      Call RemoveSource(nRow)
+    Else
+      nRow = nRow + 1
+    End If
+  Loop
+  
+  iSource.rowSource_ = nRow
+  iSource.sourceID_ = Excel.Application.WorksheetFunction.Max(sources_.Range("A:A")) + 1
+  iSource.rowOut_ = GetLastDataRow
+  
+  Call OutputSource(iSource, iPath)
+  
+  Set PrepareSourceInput = iSource
+End Function
+
+Private Function OutputSource(iSource As ItemSource, iPath As API_Path)
+  sources_.Cells(iSource.rowSource_, S_SRC_ID) = iSource.sourceID_
+  sources_.Cells(iSource.rowSource_, S_SRC_NAME) = iPath.BaseName
+  Dim iCell As Excel.Range: Set iCell = sources_.Cells(iSource.rowSource_, S_SRC_PATH)
+  iCell = iPath.Text
+  Call XLUpdateHyperlink(iCell, iPath.Text)
+End Function
+
+Private Function RemoveSource(nRow&)
+  Dim nSource&: nSource = sources_.Cells(nRow, S_SRC_ID)
+  Call sources_.Rows(nRow).Delete
+
+  Dim nDataRow&: nDataRow = FIRST_ROW
+  Do While data_.Cells(nDataRow, S_DATA_ID) <> vbNullString
+    If data_.Cells(nDataRow, S_DATA_SOURCE) = nSource Then
+      data_.Rows(nDataRow).Delete
+    Else
+      nDataRow = nDataRow + 1
+    End If
+  Loop
+End Function
+
+Private Function GetLastDataRow() As Long
+  Dim nRow&: nRow = FIRST_ROW
+  Do While data_.Cells(nRow, S_DATA_ID) <> vbNullString
+    nRow = nRow + 1
+  Loop
+  GetLastDataRow = nRow
+End Function
+
+Private Function FindSourcePath(nSource&) As String
+  Dim nRow&: nRow = FIRST_ROW
+  Do While sources_.Cells(nRow, S_SRC_ID) <> vbNullString
+    If sources_.Cells(nRow, S_SRC_ID) = nSource Then
+      FindSourcePath = sources_.Cells(nRow, S_SRC_PATH)
+      Exit Function
+    End If
+    nRow = nRow + 1
+  Loop
+End Function

src/aggregator/Declarations.bas

@@ -0,0 +1,35 @@
+Attribute VB_Name = "Declarations"
+Option Explicit
+Option Private Module
+
+Public Const SHEET_DATA = "Äàííûå"
+Public Const SHEET_SOURCES = "Èñòî÷íèêè"
+
+Public Const FIRST_ROW = 2
+
+Public Enum ItemStructure
+  S_DATA_ID = 1
+  S_DATA_SOURCE = 2
+  S_DATA_START = 3
+  S_DATA_FINISH = 4
+  S_DATA_TYPE = 5
+  S_DATA_TEXT = 6
+  S_DATA_COMMENT = 7
+End Enum
+
+Public Enum SourceStructure
+  S_SRC_ID = 1
+  S_SRC_NAME = 2
+  S_SRC_PATH = 3
+End Enum
+
+Public Enum InputStruct
+  S_IN_ID = 1
+  S_IN_START = 2
+  S_IN_FINISH = 3
+  S_IN_TYPE = 4
+  S_IN_TEXT = 5
+  S_IN_COMMENT = 6
+  S_IN_SOURCE_LABEL = 7
+  S_IN_SOURCE = 8
+End Enum

src/aggregator/DevHelper.bas

@@ -0,0 +1,28 @@
+Attribute VB_Name = "DevHelper"
+Option Private Module
+Option Explicit
+
+Private Const TEST_SOURCES = "test"
+Private Const TEST_CONFIG = "TestConfig.docx"
+
+Private Const TEST_FILES = "testFiles"
+
+Public Function Dev_PrepareSkeleton()
+  ' Do nothing
+  Call AccessData.RemoveAll
+End Function
+
+Public Function Dev_ManualRunTest()
+  Dim sSuite$: sSuite = "s_WordDocument"
+  Dim sTest$: sTest = "t_IteratorStyle"
+  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_DBMarkup": Set Dev_GetTestSuite = New s_DBMarkup
+ '   Case "s_WordDocument": Set Dev_GetTestSuite = New s_WordDocument
+  End Select
+End Function

src/aggregator/ItemLink.cls

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

src/aggregator/ItemSource.cls

@@ -0,0 +1,14 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ItemSource"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public sourceID_ As Long
+Public rowOut_ As Long
+Public rowSource_ As Long

src/aggregator/MUD_ImportWord.frm

@@ -0,0 +1,82 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} MUD_ImportWord 
+   Caption         =   "Çàãðóçêà äîêóìåíòà Word"
+   ClientHeight    =   1155
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   6780
+   OleObjectBlob   =   "MUD_ImportWord.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "MUD_ImportWord"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private configs_ As Collection
+Public isCancelled_ As Boolean
+
+Private Sub UserForm_Initialize()
+  isCancelled_ = True
+  Set configs_ = New Collection
+End Sub
+
+Private Sub UserForm_Terminate()
+  isCancelled_ = True
+  Call Me.Hide
+End Sub
+
+Public Function Init()
+  Dim activeConfig As ItemConfigDescriptor: Set activeConfig = SelectedConfig
+  Dim selectedID&: selectedID = 0
+  Set configs_ = GetConfigList
+  
+  Call CBConfig.Clear
+  Dim nItem&
+  For nItem = 1 To configs_.Count
+    Dim confName$: confName = configs_.Item(nItem).name_
+    Call CBConfig.AddItem(confName)
+    If Not activeConfig Is Nothing Then _
+      If activeConfig.name_ = confName Then _
+        selectedID = nItem - 1
+  Next nItem
+  
+  CBConfig.ListIndex = selectedID
+  
+  isCancelled_ = True
+End Function
+
+Public Property Get FileName() As String
+  FileName = TBDocument.Text
+End Property
+
+Public Property Get SelectedConfig() As ItemConfigDescriptor
+  If CBConfig.ListIndex <> -1 Then _
+    Set SelectedConfig = configs_.Item(CBConfig.ListIndex + 1)
+End Property
+
+Private Sub DocumentBtn_Click()
+  Dim sFileName$: sFileName = UserInteraction.PromptFileFilter( _
+                                sInitialPath:=ThisWorkbook.Path, _
+                                sDescription:="Äîêóìåíò Word", _
+                                sFilter:="*.docx;*.doc;*.docm")
+  If sFileName <> vbNullString Then _
+    TBDocument.Text = sFileName
+End Sub
+
+Private Sub CancelBtn_Click()
+  isCancelled_ = True
+  Call Me.Hide
+End Sub
+
+Private Sub OkBtn_Click()
+  If FileName = vbNullString Or SelectedConfig Is Nothing Then
+    Call UserInteraction.ShowMessage(EM_VALIDATION_FAIL)
+    Exit Sub
+  End If
+  
+  isCancelled_ = False
+  Call Me.Hide
+End Sub

src/aggregator/Main.bas

@@ -0,0 +1,66 @@
+Attribute VB_Name = "Main"
+Option Explicit
+
+Public Sub RunImportExcel()
+  Dim sFileName$: sFileName = UserInteraction.PromptFileFilter( _
+                                sInitialPath:=ThisWorkbook.Path, _
+                                sDescription:="Òàáëèöà Excel", _
+                                sFilter:="*.xlsx;*.xls;*.xlsm")
+  If sFileName = vbNullString Then _
+    Exit Sub
+  Dim xlApp As New API_XLWrapper
+  If xlApp.OpenDocument(sFileName, bReadOnly:=True) Is Nothing Then _
+    Exit Sub
+  
+  Dim iData As DB_Markup: Set iData = AccessData
+  Dim bIsLoaded As Boolean: bIsLoaded = iData.ImportFromExcel(xlApp.Document.Sheets(1))
+  Call xlApp.ReleaseDocument
+  
+  If bIsLoaded Then _
+    Call UserInteraction.ShowMessage(IM_IMPORT_OK)
+End Sub
+
+Public Sub RunImportWord()
+  Call MUD_ImportWord.Init
+  Call MUD_ImportWord.Show
+  If MUD_ImportWord.isCancelled_ Then _
+    Exit Sub
+  
+  Dim theMarkup As New MarkupAPI
+  If Not theMarkup.config_.Load(MUD_ImportWord.SelectedConfig.path_) Then
+    Call UserInteraction.ShowMessage(EM_CANNOT_LOAD_CONFIG)
+    Exit Sub
+  End If
+  
+  Dim wordApp As New API_WordWrapper
+  If wordApp.OpenDocument(MUD_ImportWord.FileName, bReadOnly:=True) Is Nothing Then _
+    Exit Sub
+  
+  Dim iData As DB_Markup: Set iData = AccessData
+  Dim iDoc As New InfoDocument: Call iDoc.Init(wordApp.Document, theMarkup)
+  Call iDoc.SyncStyles
+  Dim bIsLoaded As Boolean: bIsLoaded = iData.ImportFromWord(iDoc)
+  Call wordApp.ReleaseDocument(bSaveChanges:=False)
+  
+  If bIsLoaded Then _
+    Call UserInteraction.ShowMessage(IM_IMPORT_OK)
+End Sub
+
+Public Sub RunFollowLink()
+  If Excel.Application.ActiveSheet.Name <> SHEET_DATA Then _
+    Exit Sub
+    
+  Dim iData As DB_Markup: Set iData = AccessData
+  Dim nSelectedRow&: nSelectedRow = Excel.Selection.Cells(1, 1).Row
+  Dim iLink As ItemLink: Set iLink = iData.GetLinkFor(nSelectedRow)
+  If iLink Is Nothing Then
+    Call UserInteraction.ShowMessage(EM_INVALID_SOURCE)
+    Exit Sub
+  End If
+  
+  Call ShowDocumentLink(iLink)
+End Sub
+
+Public Sub RunClearAll()
+  Call AccessData.RemoveAll
+End Sub

src/aggregator/MainImpl.bas

@@ -0,0 +1,40 @@
+Attribute VB_Name = "MainImpl"
+Option Private Module
+Option Explicit
+
+Public Function AccessData() As DB_Markup
+  Static s_Data As DB_Markup
+  
+  If s_Data Is Nothing Then
+    Set s_Data = New DB_Markup
+    Call s_Data.Init(ThisWorkbook.Worksheets(SHEET_DATA), ThisWorkbook.Worksheets(SHEET_SOURCES))
+  End If
+  
+  Set AccessData = s_Data
+End Function
+
+Public Function ShowDocumentLink(iLink As ItemLink)
+  Dim fso As New Scripting.FileSystemObject
+  If Not fso.FileExists(iLink.path_) Then
+    Call UserInteraction.ShowMessage(EM_FILE_MISSINNG, iLink.path_)
+    Exit Function
+  End If
+  
+  Dim wordAppl As New API_WordWrapper
+  If wordAppl.OpenDocument(iLink.path_, bReadOnly:=True) Is Nothing Then _
+    Exit Function
+  
+  Dim theDoc As Word.Document: Set theDoc = wordAppl.Document
+  If theDoc.Range.End < iLink.finish_ Then
+    Call UserInteraction.ShowMessage(EM_FILE_TOO_SHORT)
+    Exit Function
+  End If
+  
+  Dim targetRng As Word.Range: Set targetRng = theDoc.Range(iLink.start_, iLink.finish_)
+  Call targetRng.Select
+  Call theDoc.ActiveWindow.ScrollIntoView(targetRng)
+  
+  Call ActivateWindowHwnd(theDoc.ActiveWindow.hwnd)
+End Function
+
+

src/aggregator/z_UIMessages.bas

@@ -0,0 +1,62 @@
+Attribute VB_Name = "z_UIMessages"
+' Messaging module
+Option Private Module
+Option Explicit
+
+Public Enum MsgCode
+  MSG_OK = 0
+  
+  EM_VALIDATION_FAIL
+  EM_CANNOT_LOAD_CONFIG
+  EM_FILE_MISSINNG
+  EM_FILE_TOO_SHORT
+  EM_INVALID_SOURCE
+  
+  IM_IMPORT_OK
+
+  QM_CLEAR_BEFORE_READD
+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_VALIDATION_FAIL:          Call MsgBox("Çàïîëíèòå âñå ïîëÿ", vbExclamation)
+  Case EM_CANNOT_LOAD_CONFIG:       Call MsgBox("Íå óäàëîñü çàãðóçèòü êîíôèãóðàöèþ", vbExclamation)
+  Case EM_FILE_MISSINNG:            Call MsgBox(Fmt("Ôàéë íå ñóùåñòâóåò: {1}", unwrapped), vbExclamation)
+  Case EM_FILE_TOO_SHORT:           Call MsgBox("Äèàïàçîí ññûëêè èìååò êîîðäèíàòû, ïðåâûøàþùèå ðàçìåð îòêðûòîãî ôàéëà", vbExclamation)
+  Case EM_INVALID_SOURCE:           Call MsgBox("Îøèáêà â äàííûõ: íå íàéäåí èñòî÷íèê", vbExclamation)
+    
+  Case IM_IMPORT_OK:                Call MsgBox("Äàííûå çàãðóæåíû èç ôàéëà", vbInformation)
+    
+  Case Else:                        Call MsgBox("Invalid message code", vbCritical)
+  End Select
+End Function
+
+Public Function UIAskQuestion(theCode As MsgCode, ParamArray params() As Variant) As Boolean
+  Dim unwrapped As Variant: unwrapped = params
+  unwrapped = FixForwardedParams(unwrapped)
+  
+  Dim answer&: answer = vbNo
+  Select Case theCode
+  Case QM_CLEAR_BEFORE_READD
+    answer = MsgBox("Äàííûé äîêóìåíò óæå äîáàâëåí â áàçó. Óäàëèòü âñå åãî äàííûå ïåðåä îáíîâëåíèåì?", vbYesNo + vbQuestion)
+        
+  Case Else
+    Call MsgBox("Invalid message code", vbCritical)
+  End Select
+  UIAskQuestion = answer = vbYes
+End Function

src/aggregator/z_UIRibbon.bas

@@ -0,0 +1,12 @@
+Attribute VB_Name = "z_UIRibbon"
+' Îáðàáîòêà íàæàòèé íà êíîïêè â ðèááîíå
+Option Explicit
+
+Sub OnRibbonBtn(iControl As IRibbonControl)
+  Select Case iControl.ID
+    Case "ImportExcel":       Call RunImportExcel
+    Case "ImportWord":        Call RunImportWord
+    Case "FollowLink":        Call RunFollowLink
+    Case "ClearAll":          Call RunClearAll
+  End Select
+End Sub

src/common/InfoCategory.cls

@@ -0,0 +1,97 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "InfoCategory"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public id_ As Long
+Public name_ As String
+Public info_ As String
+Public style_ As String
+Public composition_ As Scripting.Dictionary
+
+Private Sub Class_Initialize()
+  Set composition_ = New Scripting.Dictionary
+End Sub
+
+Public Function InitBasic(nID&, sName$, Optional sInfo$ = "")
+  id_ = nID
+  name_ = sName
+  info_ = sInfo
+End Function
+
+Public Function Clone() As InfoCategory
+  Set Clone = New InfoCategory
+  With Clone
+    .id_ = id_
+    .name_ = name_
+    .info_ = info_
+    .style_ = style_
+  End With
+  
+  Dim iBasic As Variant
+  For Each iBasic In composition_
+    Call Clone.composition_.Add(iBasic, composition_(iBasic))
+  Next iBasic
+End Function
+
+Public Property Get IsCombo() As Boolean
+  IsCombo = composition_.Count > 1
+End Property
+
+Public Property Get IsComplete() As Boolean
+  IsComplete = style_ <> vbNullString
+End Property
+
+Public Function ImportComposition(sComposition$) As Boolean
+  ImportComposition = False
+  
+  Call composition_.RemoveAll
+  Dim sPart As Variant
+  For Each sPart In VBA.Split(sComposition, SPLITTER_COMPOSITION)
+    Dim sID$: sID = Trim(sPart)
+    If Not IsNumeric(sID) Then _
+      Exit Function
+    Call composition_.Add(VBA.CLng(sID), 0)
+  Next sPart
+    
+  ImportComposition = True
+End Function
+
+Public Function GetCompositionString() As String
+  Dim sComposition$: sComposition = ""
+  Dim catID As Variant
+  For Each catID In composition_
+    If sComposition <> "" Then _
+      sComposition = sComposition & SPLITTER_COMPOSITION & " "
+    sComposition = sComposition & catID
+  Next catID
+  GetCompositionString = sComposition
+End Function
+
+Public Function GetFormat(iDoc As Word.Document) As InfoFormat
+  If Not IsComplete Then _
+    Exit Function
+  Dim frs As New InfoFormat: Call frs.InitFromWordDiff(iDoc.Styles(wdStyleNormal), iDoc.Styles(style_))
+  Set GetFormat = frs
+End Function
+
+Public Function IsIncludedIn(anotherCat As InfoCategory) As Boolean
+  If Not IsCombo Then
+    IsIncludedIn = anotherCat.composition_.Exists(id_)
+    Exit Function
+  End If
+  
+  IsIncludedIn = False
+  Dim iBasic As Variant
+  For Each iBasic In composition_
+    If Not anotherCat.composition_.Exists(iBasic) Then _
+      Exit Function
+  Next iBasic
+  IsIncludedIn = True
+End Function

src/common/InfoConfig.cls

@@ -0,0 +1,466 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "InfoConfig"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+'================ Êëàññ-îáîëî÷êà äëÿ êîíôèãóðàòîðà øðèôòîâûõ âûäåëåíèé =========================
+Option Explicit
+
+Public sourcePath_ As String
+Public hash_ As Long
+
+Public categories_ As Scripting.Dictionary ' map of (catID, InfoCategory)
+
+Private nextID_ As Long
+
+Private Sub Class_Initialize()
+  Set categories_ = New Scripting.Dictionary
+  nextID_ = 1
+End Sub
+
+Public Property Get IsLoaded() As Boolean
+  IsLoaded = sourcePath_ <> ""
+End Property
+
+Public Function Load(sFileName$) As Boolean
+  Load = False
+  
+  Dim fso As New Scripting.FileSystemObject
+  If Not fso.FileExists(sFileName) Then _
+    Exit Function
+  
+  Dim wrapper As New API_WordWrapper
+  Call wrapper.CreateApplication(bIsVisible:=False)
+  Dim theDoc As Word.Document: Set theDoc = wrapper.OpenDocument(sFileName, bReadOnly:=True, bTrackMRU:=False)
+  If theDoc Is Nothing Then _
+    Exit Function
+  If theDoc.Tables.Count = 0 Then
+    Call wrapper.ReleaseDocument
+    Exit Function
+  End If
+  
+  Load = ScanCategories(theDoc.Tables(1))
+  If Load Then
+    sourcePath_ = sFileName
+    Call UpdateHash
+  End If
+  
+  Call wrapper.ReleaseDocument
+  
+  Load = True
+End Function
+
+Public Function Contains(catID&) As Boolean
+  Contains = categories_.Exists(catID)
+End Function
+
+Public Function GetAt(catID&) As InfoCategory
+  If Contains(catID) Then _
+    Set GetAt = categories_(catID)
+End Function
+
+Public Function CountIncomplete() As Long
+  Dim iCat As InfoCategory
+  Dim catID As Variant
+  For Each catID In categories_
+    Set iCat = categories_(catID)
+    If Not iCat.IsComplete Then _
+      CountIncomplete = CountIncomplete + 1
+  Next catID
+End Function
+
+Public Function CountCombos() As Long
+  Dim iCat As InfoCategory
+  Dim catID As Variant
+  For Each catID In categories_
+    Set iCat = categories_(catID)
+    If iCat.IsCombo Then _
+      CountCombos = CountCombos + 1
+  Next catID
+End Function
+
+' Throws: ERR_CAT_NAME_TAKEN
+Public Function AddBasicCategory(sName$, Optional sInfo$ = "") As InfoCategory
+  If sName = vbNullString Then _
+    Exit Function
+  If Not FindName(sName) Is Nothing Then _
+    Call Err.Raise(ERR_CAT_NAME_TAKEN, Source:=sName)
+    
+  Dim newCat As New InfoCategory: Call newCat.InitBasic(nextID_, sName, sInfo)
+  nextID_ = nextID_ + 1
+  Call categories_.Add(newCat.id_, newCat)
+  Call UpdateHash
+  Set AddBasicCategory = newCat
+End Function
+
+' Throws: ERR_CAT_NAME_TAKEN, ERR_COMBO_TAKEN, ERR_UNKNOWN_CAT_ID
+Public Function AddCombinedCategory(sName$, iArguments As Scripting.Dictionary, Optional sInfo$ = "") As InfoCategory
+  Dim existingCombo As InfoCategory: Set existingCombo = FindComposition(iArguments)
+  If Not existingCombo Is Nothing Then _
+    Call Err.Raise(ERR_COMBO_TAKEN, existingCombo.id_)
+  
+  Dim iComposition As Scripting.Dictionary: Set iComposition = ReduceComposition(iArguments)
+  If iComposition Is Nothing Then _
+    Call Err.Raise(ERR_UNKNOWN_CAT_ID)
+    
+  Dim iNewCat As InfoCategory: Set iNewCat = AddBasicCategory(sName, sInfo)
+  If iNewCat Is Nothing Then _
+    Exit Function
+    
+  Set iNewCat.composition_ = iComposition
+  
+  Call UpdateHash
+  Set AddCombinedCategory = iNewCat
+End Function
+
+Public Function EraseCategory(targetID&) As Boolean
+  EraseCategory = InternalErase(targetID)
+  If Not EraseCategory Then _
+    Exit Function
+    
+  Dim toDelete As New Collection
+  Dim iCat As InfoCategory
+  Dim catID As Variant
+  For Each catID In categories_
+    Set iCat = categories_(catID)
+    If iCat.composition_.Exists(targetID) Then _
+      Call toDelete.Add(catID)
+  Next catID
+  
+  For Each catID In toDelete
+    Call InternalErase(CStr(catID))
+  Next catID
+  Call UpdateHash
+End Function
+
+Public Function ReduceComposition(iCats As Scripting.Dictionary) As Scripting.Dictionary
+  Dim iComp As New Scripting.Dictionary
+  Dim catID As Variant
+  For Each catID In iCats
+    Dim iCat As InfoCategory: Set iCat = GetAt(CLng(catID))
+    If iCat Is Nothing Then _
+      Exit Function
+    If iCat.IsCombo Then
+      Dim catElement As Variant
+      For Each catElement In iCat.composition_
+        iComp(catElement) = 0
+      Next catElement
+    Else
+       iComp.Item(catID) = 0
+    End If
+  Next catID
+  Set ReduceComposition = iComp
+End Function
+
+Public Function GetChildrenOf(targetID&) As Scripting.Dictionary
+  Dim iParent As InfoCategory: Set iParent = GetAt(targetID)
+  If iParent Is Nothing Then _
+    Exit Function
+  
+  Dim iChildren As New Scripting.Dictionary
+  Dim catID As Variant
+  Dim iCat As InfoCategory
+  For Each catID In categories_
+    If catID <> targetID Then
+      Set iCat = categories_(catID)
+      If iParent.IsIncludedIn(iCat) Then _
+        Call iChildren.Add(catID, 0)
+    End If
+  Next catID
+  Set GetChildrenOf = iChildren
+End Function
+
+' Throws: ERR_STYLE_TAKEN, ERR_FORMAT_TAKEN, ERR_STYLE_NO_FORMAT
+Public Function AssignStyle(targetID&, wStyle As Word.Style, iDoc As Word.Document) As Boolean
+  AssignStyle = False
+  Dim target As InfoCategory: Set target = GetAt(targetID)
+  If target Is Nothing Then _
+    Exit Function
+  If target.style_ = wStyle.NameLocal Then _
+    Exit Function
+  If Not FindStyle(wStyle.NameLocal) Is Nothing Then _
+    Call Err.Raise(ERR_STYLE_TAKEN)
+
+  Dim iFormat As New InfoFormat: Call iFormat.InitFromWordDiff(iDoc.Styles(wdStyleNormal), wStyle)
+  If iFormat.IsEmpty Then _
+    Call Err.Raise(ERR_STYLE_NO_FORMAT, Source:=wStyle.NameLocal)
+  
+  Dim iClone As InfoCategory: Set iClone = FindFormat(iFormat, iDoc)
+  If Not iClone Is Nothing Then _
+    If iClone.id_ <> targetID Then _
+      Call Err.Raise(ERR_FORMAT_TAKEN, Source:=iClone.name_)
+
+  If iDoc.FullName <> sourcePath_ Then _
+    Call WordCopyStyle(iDoc.Application, iDoc.FullName, sourcePath_, wStyle.NameLocal)
+  target.style_ = wStyle.NameLocal
+  
+  Call UpdateHash
+  AssignStyle = True
+End Function
+
+' Throws ERR_INCOMPLETE_COMPOSITION, ERR_CANNOT_ADD_STYLE
+Public Function CreateStyle(targetID&, sStyleName$, iDoc As Word.Document) As Boolean
+  CreateStyle = False
+  Dim target As InfoCategory: Set target = GetAt(targetID)
+  If target Is Nothing Then _
+    Exit Function
+  If target.IsComplete Or Not target.IsCombo Then _
+    Exit Function
+  
+  Dim iCombo As New Collection
+  Dim parentID As Variant
+  Dim iParent As InfoCategory
+  For Each parentID In target.composition_
+    Set iParent = GetAt(CLng(parentID))
+    If Not iParent.IsComplete Then _
+      Call Err.Raise(ERR_INCOMPLETE_COMPOSITION)
+    Call iCombo.Add(iDoc.Styles(iParent.style_))
+  Next parentID
+  
+  Dim newStyle As Word.Style: Set newStyle = CreateStyleCombination(sStyleName, iCombo, iDoc)
+  If newStyle Is Nothing Then _
+    Call Err.Raise(ERR_CANNOT_ADD_STYLE)
+  
+  If iDoc.FullName <> sourcePath_ Then _
+    Call WordCopyStyle(iDoc.Application, iDoc.FullName, sourcePath_, newStyle.NameLocal)
+  target.style_ = newStyle.NameLocal
+  
+  Call UpdateHash
+  CreateStyle = True
+End Function
+
+Public Function FindStyle(sStyle$) As InfoCategory
+  Dim iCat As InfoCategory
+  Dim catID As Variant
+  For Each catID In categories_
+    Set iCat = categories_(catID)
+    If iCat.style_ = sStyle Then
+      Set FindStyle = iCat
+      Exit Function
+    End If
+  Next catID
+End Function
+
+Public Function FindName(sName$) As InfoCategory
+  Dim iCat As InfoCategory
+  Dim catID As Variant
+  For Each catID In categories_
+    Set iCat = categories_(catID)
+    If iCat.name_ = sName Then
+      Set FindName = iCat
+      Exit Function
+    End If
+  Next catID
+End Function
+
+Public Function FindComposition(iComposition As Scripting.Dictionary) As InfoCategory
+  If iComposition.Count = 0 Then _
+    Exit Function
+    
+  Dim iBasicComp As Scripting.Dictionary: Set iBasicComp = ReduceComposition(iComposition)
+  If iBasicComp Is Nothing Then _
+    Exit Function
+    
+  Dim iCat As InfoCategory
+  Dim catID As Variant
+  For Each catID In categories_
+    Set iCat = categories_(catID)
+    If CompareDeep(iBasicComp, iCat.composition_) = 0 Then
+      Set FindComposition = iCat
+      Exit Function
+    End If
+  Next catID
+End Function
+
+Public Function FindFormat(iTarget As InfoFormat, iDoc As Word.Document) As InfoCategory
+  Dim catID As Variant
+  For Each catID In categories_
+    Dim iCat As InfoCategory: Set iCat = categories_(catID)
+    Dim iFormat As InfoFormat: Set iFormat = iCat.GetFormat(iDoc)
+    If Not iFormat Is Nothing Then
+      If iTarget.Compare(iFormat) = 0 Then
+        Set FindFormat = iCat
+        Exit Function
+      End If
+    End If
+  Next catID
+End Function
+
+Public Function SyncDocument(target As Word.Document)
+  If hash_ <> GetMetadata(target, VAR_HASH) Or sourcePath_ <> GetMetadata(target, VAR_MUPATH) Then
+    Call SyncStyles(target.Application, target.FullName)
+    Call SetMetadata(target, VAR_HASH, hash_)
+    Call SetMetadata(target, VAR_MUPATH, sourcePath_)
+  End If
+End Function
+
+Public Function SyncStyles(wordApp As Word.Application, sDestination$)
+  Dim catID As Variant
+  For Each catID In categories_
+    Dim iCat As InfoCategory: Set iCat = categories_(catID)
+    If iCat.IsComplete Then _
+      Call WordCopyStyle(wordApp, sourcePath_, sDestination, iCat.style_)
+  Next catID
+End Function
+
+Public Function SaveAs(outPath$) As Boolean
+  SaveAs = False
+  
+  Dim wrapper As New API_WordWrapper
+  Dim outDoc As Word.Document: Set outDoc = wrapper.OpenDocument(outPath, bReadOnly:=False)
+  If outDoc Is Nothing Then _
+    Exit Function
+  
+  Call SyncStyles(wrapper.Application, outPath)
+  sourcePath_ = outPath
+  
+  Call InternalSaveTo(outDoc)
+  Call wrapper.ReleaseDocument
+  
+  SaveAs = True
+End Function
+
+Public Function Save() As Boolean
+  Save = False
+  
+  Dim wrapper As New API_WordWrapper
+  Dim outDoc As Word.Document: Set outDoc = wrapper.OpenDocument(sourcePath_, bReadOnly:=False)
+  If outDoc Is Nothing Then _
+    Exit Function
+    
+  Call InternalSaveTo(outDoc)
+  Call wrapper.ReleaseDocument
+  
+  Save = True
+End Function
+
+' =========
+Private Function InternalErase(targetID&) As Boolean
+  InternalErase = categories_.Exists(targetID)
+  If InternalErase Then _
+    Call categories_.Remove(targetID)
+End Function
+
+Private Function ScanCategories(iSource As Word.Table)
+  ScanCategories = False
+  
+  Call categories_.RemoveAll
+  
+  Dim nRow&
+  Dim iCat As InfoCategory
+  For nRow = WORD_FIRST_ROW To iSource.Rows.Count Step 1
+    Dim sID$: sID = TrimWhitespace(iSource.Cell(nRow, WORD_CAT_ID).Range.Text)
+    If Not IsNumeric(sID) Then _
+      Exit Function
+
+    Set iCat = New InfoCategory
+    With iCat
+      .id_ = VBA.CLng(sID)
+      .name_ = TrimWhitespace(iSource.Cell(nRow, WORD_CAT_NAME).Range.Text)
+      .info_ = TrimWhitespace(iSource.Cell(nRow, WORD_CAT_INFO).Range.Text)
+      .style_ = TrimWhitespace(iSource.Cell(nRow, WORD_CAT_STYLE).Range.Text)
+    End With
+    Dim sComp$: sComp = TrimWhitespace(iSource.Cell(nRow, WORD_CAT_COMP).Range.Text)
+    If Not iCat.ImportComposition(sComp) Then _
+      Exit Function
+    
+    Call categories_.Add(iCat.id_, iCat)
+    
+    If nextID_ <= iCat.id_ Then _
+      nextID_ = iCat.id_ + 1
+  Next nRow
+  
+  ScanCategories = True
+End Function
+
+Private Function InternalSaveTo(outDoc As Word.Document)
+  Call PrepareOutput(outDoc)
+  Call OutputCategories(outDoc.Tables(1))
+  Call outDoc.Save
+End Function
+
+Private Function PrepareOutput(target As Word.Document)
+  Dim catTable As Word.Table
+  If target.Tables.Count = 0 Then
+    target.Sections(1).PageSetup.Orientation = wdOrientLandscape
+    Call target.Range.InsertParagraphAfter
+    Set catTable = target.Tables.Add(target.Paragraphs.Last.Range, 1, 5)
+    With catTable
+      .Cell(1, WORD_CAT_ID).Range = "ID"
+      .Cell(1, WORD_CAT_NAME).Range = "Íàçâàíèå"
+      .Cell(1, WORD_CAT_STYLE).Range = "Ñòèëü"
+      .Cell(1, WORD_CAT_INFO).Range = "Îïèñàíèå"
+      .Cell(1, WORD_CAT_COMP).Range = "Ñîñòàâëÿþùèå"
+      
+      .Borders.InsideLineStyle = wdLineStyleSingle
+      .Borders.OutsideLineStyle = wdLineStyleDouble
+    End With
+  Else
+    Set catTable = target.Tables(1)
+  End If
+  
+  Do While catTable.Rows.Count <> 1
+    Call catTable.Rows.Last.Delete
+  Loop
+End Function
+
+Private Function OutputCategories(target As Word.Table)
+  Dim outDoc As Word.Document: Set outDoc = target.Range.Document
+  Dim iCat As InfoCategory
+  For Each iCat In categories_
+    Dim newRow As Word.Row: Set newRow = target.Rows.Add
+    With newRow
+      .Cells(WORD_CAT_ID).Range = iCat.id_
+      .Cells(WORD_CAT_NAME).Range = iCat.name_
+      .Cells(WORD_CAT_STYLE).Range = iCat.style_
+      .Cells(WORD_CAT_INFO).Range = iCat.info_
+      .Cells(WORD_CAT_COMP).Range = iCat.GetCompositionString
+      If iCat.IsComplete Then _
+        .Cells(WORD_CAT_STYLE).Range.Style = iCat.style_
+    End With
+  Next iCat
+End Function
+
+Private Function CreateStyleCombination(sStyle$, iCombo As Collection, iDoc As Word.Document) As Word.Style
+  If WordStyleExists(iDoc, sStyle) Then _
+    Exit Function
+  
+  Dim iFormat As New InfoFormat
+  Dim iArgFormat As InfoFormat
+  Dim iArg As Word.Style
+  For Each iArg In iCombo
+    Set iArgFormat = New InfoFormat: Call iArgFormat.InitFromWordDiff(iDoc.Styles(wdStyleNormal), iArg)
+    If Not iFormat.IsCompatibleWith(iArgFormat) Then _
+      Exit Function
+    Call iFormat.MergeWith(iArgFormat)
+  Next iArg
+  
+  Dim sResult As Word.Style: Set sResult = iDoc.Styles.Add(sStyle$, wdStyleTypeCharacter)
+  Call iFormat.ApplyToWordFont(sResult.Font)
+  Set CreateStyleCombination = sResult
+End Function
+
+Private Function UpdateHash()
+  hash_ = 1
+  Dim nCount&: nCount = 1
+  
+  Dim catID As Variant
+  Dim iCat As InfoCategory
+  For Each catID In categories_
+    Set iCat = categories_(catID)
+    hash_ = (hash_ + HashName(iCat.style_) + nCount + HashName(iCat.id_)) Mod 69208103 * 31&
+    nCount = nCount + 1
+  Next catID
+End Function
+
+Private Function HashName(sName$) As Long
+  HashName = 1
+  Dim nChar&
+  For nChar = 1 To VBA.Len(sName)
+    HashName = (HashName + VBA.AscW(VBA.Mid(sName, nChar, 1))) Mod 69208103 * 31&
+  Next nChar
+End Function

src/common/InfoDocument.cls

@@ -0,0 +1,338 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "InfoDocument"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private Enum PuncType
+  PT_NONE = 0
+  PT_END = 1
+  PT_CONTINUATION = 2
+End Enum
+
+Public doc_ As Word.Document
+Public markup_ As MarkupAPI
+
+Public Function Init(iDoc As Word.Document, iMarkup As MarkupAPI)
+  Set doc_ = iDoc
+  Set markup_ = iMarkup
+End Function
+
+Public Function SyncStyles()
+  Call markup_.SyncWord(doc_)
+End Function
+
+Public Function GetFormatIterator(catID&, Optional nStart& = 0) As IteratorFormat
+' Èòåðàòîð ïî êàòåãîðèè è åå ïîòîìêàì, âêëþ÷àÿ ðó÷íîå ôîðìàòèðîâàíèå
+  If Not markup_.config_.Contains(catID) Then _
+    Exit Function
+  Dim iCat As InfoCategory: Set iCat = markup_.config_.GetAt(catID)
+  If Not iCat.IsComplete Then _
+    Exit Function
+  If nStart > doc_.Range.End Then _
+    Exit Function
+  
+  Set GetFormatIterator = New IteratorFormat
+  Call GetFormatIterator.Init(doc_, iCat.GetFormat(doc_), nStart)
+End Function
+
+Public Function GetPreciseIterator(catID&, Optional nStart& = 0) As IteratorStyle
+' Èòåðàòîð òîëüêî ïî ñòèëþ çàäàííîé êàòåãîðèè
+  If Not markup_.config_.Contains(catID) Then _
+    Exit Function
+  Dim iCat As InfoCategory: Set iCat = markup_.config_.GetAt(catID)
+  If Not iCat.IsComplete Then _
+    Exit Function
+  If nStart > doc_.Range.End Then _
+    Exit Function
+  
+  Dim cStyles As New Collection
+  Call cStyles.Add(iCat.style_)
+  Set GetPreciseIterator = New IteratorStyle
+  Call GetPreciseIterator.Init(doc_, cStyles, nStart)
+End Function
+
+Public Function GetStylesIterator(catID&, Optional nStart& = 0) As IteratorStyle
+' Èòåðàòîð ïî êàòåãîðèè è åå ïîòîìêàì
+  If Not markup_.config_.Contains(catID) Then _
+    Exit Function
+  Dim iCat As InfoCategory: Set iCat = markup_.config_.GetAt(catID)
+  If Not iCat.IsComplete Then _
+    Exit Function
+  If nStart > doc_.Range.End Then _
+    Exit Function
+  
+  Dim cStyles As New Collection
+  Call cStyles.Add(iCat.style_)
+  Dim aCat As InfoCategory
+  For Each aCat In markup_.config_.GetChildrenOf(catID)
+    Call cStyles.Add(aCat.style_)
+  Next aCat
+  
+  Set GetStylesIterator = New IteratorStyle
+  Call GetStylesIterator.Init(doc_, cStyles, nStart)
+End Function
+
+Public Function ApplyCategory(iCat As InfoCategory, ByRef target As Word.Range) As Boolean
+  ApplyCategory = False
+
+  If Not iCat.IsComplete Then _
+    Exit Function
+  target.Style = iCat.style_
+  
+  ApplyCategory = True
+End Function
+
+Public Function ApplyFragments(iFragments As Collection) As Boolean
+  ApplyFragments = False
+  
+  Dim iFrag As ItemFragment
+  For Each iFrag In iFragments
+    If Not markup_.config_.Contains(iFrag.id_) Then _
+      Exit Function
+    If Not ApplyCategory(markup_.config_.GetAt(iFrag.id_), doc_.Range(iFrag.start_, iFrag.end_)) Then _
+      Exit Function
+  Next iFrag
+
+  ApplyFragments = True
+End Function
+
+Public Function AddCategory(iAddedCat As InfoCategory, ByRef target As Word.Range) As Boolean
+  AddCategory = False
+  
+  If Not iAddedCat.IsComplete Then _
+    Exit Function
+    
+  Dim sCurrentStyle$: sCurrentStyle = target.Style.NameLocal
+  If sCurrentStyle = iAddedCat.style_ Then
+    AddCategory = True
+    Exit Function
+  End If
+  
+  Dim iCurrentCat As InfoCategory: Set iCurrentCat = markup_.config_.FindStyle(sCurrentStyle)
+  If iCurrentCat Is Nothing Then
+    target.Style = iAddedCat.style_
+    AddCategory = True
+    Exit Function
+  ElseIf iCurrentCat.composition_.Exists(iAddedCat.id_) Then
+    AddCategory = True
+    Exit Function
+  End If
+  
+  Dim iComposition As Scripting.Dictionary:  Set iComposition = CSet(iAddedCat.id_, iCurrentCat.id_)
+  Dim iCombo As InfoCategory: Set iCombo = markup_.config_.FindComposition(iComposition)
+  If Not iCombo Is Nothing Then
+    target.Style = iCombo.style_
+    AddCategory = True
+    Exit Function
+  End If
+End Function
+
+Public Function SetCategoryVisible(catID&, bShow As Boolean)
+  Dim iter As IteratorFormat: Set iter = GetFormatIterator(catID)
+  If iter Is Nothing Then _
+    Exit Function
+  Do While Not iter.MoveNext Is Nothing
+    Dim rFragment As Word.Range: Set rFragment = FixFragment(iter.Range)
+    rFragment.Font.Hidden = Not bShow
+  Loop
+End Function
+
+Public Function SetCategoryHighlight(catID&, bHighlight As Boolean)
+  Dim iter As IteratorFormat: Set iter = GetFormatIterator(catID)
+  If iter Is Nothing Then _
+    Exit Function
+  Do While Not iter.MoveNext Is Nothing
+    Dim rFragment As Word.Range: Set rFragment = iter.Range
+    rFragment.HighlightColorIndex = IIf(bHighlight, wdYellow, wdNoHighlight)
+  Loop
+End Function
+
+Public Function GetAllHighlights() As Collection ' of ItemFragment
+  Set GetAllHighlights = New Collection
+  Dim rFind As Word.Range: Set rFind = doc_.Range(0, 0)
+  With rFind.Find
+    .ClearFormatting
+    .Highlight = True
+  End With
+  With rFind
+    Do While .Find.Execute
+      Dim aFrag As New ItemFragment
+      aFrag.id_ = .HighlightColorIndex
+      aFrag.start_ = .Start
+      aFrag.end_ = .End
+      Call GetAllHighlights.Add(aFrag.Clone)
+    Loop
+  End With
+End Function
+
+Public Function GetBasicFragmentsCompound() As Collection ' of ItemFragment
+  Dim catIntervals As New Scripting.Dictionary
+  
+  Dim iCat As InfoCategory
+  Dim catID As Variant
+  For Each catID In markup_.config_.categories_
+    Set iCat = markup_.config_.categories_(catID)
+    If Not iCat.IsCombo Then _
+      Set catIntervals.Item(catID) = New CDS_CompoundIntervals
+  Next catID
+  
+  Dim allFrags As Collection: Set allFrags = GetAllFragments()
+  Dim aFrag As ItemFragment
+  For Each aFrag In allFrags
+    Set iCat = markup_.config_.GetAt(aFrag.id_)
+    If Not iCat.IsCombo Then
+      Call catIntervals(iCat.id_).AddItem(aFrag.start_, aFrag.end_)
+    Else
+      Dim comboItem As Variant
+      For Each comboItem In iCat.composition_
+        Call catIntervals(comboItem).AddItem(aFrag.start_, aFrag.end_)
+      Next comboItem
+    End If
+  Next aFrag
+  
+  Dim cResult As New Collection
+  For Each catID In markup_.config_.categories_
+    Set iCat = markup_.config_.categories_(catID)
+    If Not iCat.IsCombo Then
+      Dim interval As CDS_Interval
+      For Each interval In catIntervals(catID).items_
+        Set aFrag = New ItemFragment
+        aFrag.id_ = catID
+        aFrag.start_ = interval.start_
+        aFrag.end_ = interval.finish_
+        Call cResult.Add(aFrag)
+      Next interval
+    End If
+  Next catID
+  
+  Set GetBasicFragmentsCompound = cResult
+End Function
+
+Public Function GetAllFragments() As Collection ' of ItemFragment
+  Set GetAllFragments = New Collection
+  Dim catID As Variant
+  For Each catID In markup_.config_.categories_
+    Call InternalFragments(GetAllFragments, CLng(catID))
+  Next catID
+End Function
+
+' ============
+Private Function InternalFragments(ByRef out As Collection, catID&)
+  Dim aFrag As New ItemFragment
+  aFrag.id_ = catID
+  Dim iter As IteratorStyle: Set iter = GetPreciseIterator(catID)
+  Do While Not iter.MoveNext Is Nothing
+    aFrag.start_ = iter.Range.Start
+    aFrag.end_ = iter.Range.End
+    Call out.Add(aFrag.Clone)
+  Loop
+End Function
+
+Private Function FixFragment(target As Word.Range) As Word.Range
+  Dim rCurrent As Word.Range: Set rCurrent = WordAdjustRange(target)
+  Set FixFragment = rCurrent ' Note: alias, not copy!
+  
+  Dim rightB As ItemFragment: Set rightB = GetRightBoundary(target)
+  Dim leftB As ItemFragment: Set leftB = GetLeftBoundary(target)
+  If rightB Is Nothing Or leftB Is Nothing Then _
+    Exit Function
+  
+  If rightB.id_ = PT_NONE Or leftB.id_ = PT_NONE Then
+    If rightB.id_ = leftB.id_ Then
+      rCurrent.Start = leftB.start_
+      rCurrent.End = rightB.end_
+    End If
+  ElseIf leftB.id_ = PT_END Then
+    rCurrent.End = rightB.end_
+  ElseIf leftB.id_ = rightB.id_ Then
+    rCurrent.Start = leftB.start_
+    rCurrent.End = rightB.end_
+  Else
+    rCurrent.Start = leftB.start_
+  End If
+End Function
+
+Private Function GetLeftBoundary(target As Word.Range) As ItemFragment
+  If target.Start = 0 Then _
+    Exit Function
+  
+  Dim tRange As Word.Range: Set tRange = target.Duplicate
+  Call tRange.Collapse(wdCollapseStart)
+  Call tRange.MoveStart(wdWord, -1)
+  Dim Result As New ItemFragment
+  Result.end_ = tRange.End
+  Result.start_ = tRange.Start
+  
+  Dim sText$: sText = Trim(tRange.Text)
+  If sText Like "[" + Endings + "]" Then
+    Result.id_ = PT_END
+    Set GetLeftBoundary = Result
+    Exit Function
+  End If
+  
+  If sText Like "[" + Continuations + "]" Then
+    Result.id_ = PT_CONTINUATION
+    Set GetLeftBoundary = Result
+    Exit Function
+  End If
+  
+  If sText = "(" Then
+    Result.id_ = PT_NONE
+    Set GetLeftBoundary = Result
+    Exit Function
+  End If
+End Function
+
+Private Function GetRightBoundary(target As Word.Range) As ItemFragment
+  If target.End = target.Document.Range.End Then _
+    Exit Function
+    
+  Dim tRange As Word.Range: Set tRange = target.Duplicate
+  Call tRange.Collapse(wdCollapseEnd)
+  Call tRange.MoveEnd(wdWord, 1)
+  Dim Result As New ItemFragment
+  Result.end_ = tRange.End
+  Result.start_ = tRange.Start
+  
+  Dim sText$: sText = Trim(tRange.Text)
+  If sText Like "[" + Endings + "]" Then
+    Result.id_ = PT_END
+    Set GetRightBoundary = Result
+    Exit Function
+  End If
+  
+  If sText Like "[" + Continuations + "]" Then
+    Result.id_ = PT_CONTINUATION
+    Set GetRightBoundary = Result
+    Exit Function
+  End If
+  
+  If sText = ")" Then
+    Dim nextRight As ItemFragment: Set nextRight = GetRightBoundary(tRange)
+    If Not nextRight Is Nothing Then
+      If nextRight.id_ = PT_END Then
+        Result.id_ = PT_END
+        Result.end_ = nextRight.end_
+        Set GetRightBoundary = Result
+        Exit Function
+      End If
+    End If
+    Result.id_ = PT_NONE
+    Set GetRightBoundary = Result
+    Exit Function
+  End If
+End Function
+
+Private Function Continuations() As String
+  Continuations = ",;:-" & Chr(150) & Chr(151)
+End Function
+
+Private Function Endings() As String
+  Endings = ".?!…" & Chr(13)
+End Function

src/common/InfoFormat.cls

@@ -0,0 +1,132 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "InfoFormat"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+'================ Êëàññ äëÿ ðàáîòû ñ ïàðàìåòðàìè âûäåëåíèÿ =========================
+Option Explicit
+
+Public Enum TFormatFeature
+  T_FF_INVALID = 0
+  [_First] = 1
+  T_FF_FONT_NAME = 1
+  T_FF_FONT_SIZE
+  T_FF_TEXT_COLOR
+  T_FF_BG_COLOR
+  T_FF_BOLD
+  T_FF_STRIKETHROUGH
+  T_FF_ITALIC
+  T_FF_UNDERLINE
+  T_FF_UNDERLINE_COLOR
+  T_FF_ALLCAPS
+  [_Last] = 10
+End Enum
+
+Public features_ As Scripting.Dictionary
+
+Private Sub Class_Initialize()
+  Set features_ = New Scripting.Dictionary
+End Sub
+
+Public Function Clone() As InfoFormat
+  Set Clone = New InfoFormat
+  Dim aKey As Variant
+  For Each aKey In features_
+    Call Clone.features_.Add(aKey, features_(aKey))
+  Next aKey
+End Function
+
+Public Function InitFromWord(wStyle As Word.Style)
+  Call ClearFeatures
+  
+  Dim nFeature&
+  For nFeature = TFormatFeature.[_First] To TFormatFeature.[_Last]
+    Call features_.Add(nFeature, WordGetValue(nFeature, wStyle.Font))
+  Next nFeature
+End Function
+
+Public Function InitFromWordDiff(sBase As Word.Style, sDerived As Word.Style)
+  Call ClearFeatures
+  
+  Dim nFeature&
+  For nFeature = TFormatFeature.[_First] To TFormatFeature.[_Last]
+    If WordGetValue(nFeature, sBase.Font) <> WordGetValue(nFeature, sDerived.Font) Then _
+      Call features_.Add(nFeature, WordGetValue(nFeature, sDerived.Font))
+  Next nFeature
+End Function
+
+Public Function IsEmpty() As Boolean
+  IsEmpty = features_.Count = 0
+End Function
+
+Public Function ApplyToWordFont(ByRef target As Word.Font)
+  Dim nFeature As Variant
+  For Each nFeature In features_
+    Call WordSetValue(CLng(nFeature), target, features_(nFeature))
+  Next nFeature
+End Function
+
+Public Function Compare(rValue As InfoFormat) As Double
+  Compare = CompareDeep(features_, rValue.features_)
+End Function
+
+Public Function IsCompatibleWith(rValue As InfoFormat) As Boolean
+  IsCompatibleWith = False
+  
+  Dim nFeature As Variant
+  For Each nFeature In features_
+    If rValue.features_.Exists(nFeature) Then _
+      If features_(nFeature) <> rValue.features_(nFeature) Then _
+        Exit Function
+  Next nFeature
+  
+  IsCompatibleWith = True
+End Function
+
+' !Requires IsCompatibleWith(rValue)
+Public Function MergeWith(rValue As InfoFormat)
+  Dim nFeature As Variant
+  For Each nFeature In rValue.features_
+    features_.Item(nFeature) = rValue.features_(nFeature)
+  Next nFeature
+End Function
+
+' =========
+Private Function ClearFeatures()
+  Call features_.RemoveAll
+End Function
+
+Private Function WordGetValue(nFeature As TFormatFeature, wFont As Word.Font) As Variant
+  Select Case nFeature
+    Case T_FF_FONT_NAME: WordGetValue = wFont.Name
+    Case T_FF_FONT_SIZE: WordGetValue = wFont.Size
+    Case T_FF_BOLD: WordGetValue = wFont.Bold
+    Case T_FF_ITALIC: WordGetValue = wFont.Italic
+    Case T_FF_TEXT_COLOR: WordGetValue = wFont.TextColor
+    Case T_FF_BG_COLOR: WordGetValue = wFont.Shading.BackgroundPatternColor
+    Case T_FF_UNDERLINE_COLOR: WordGetValue = wFont.UnderlineColor
+    Case T_FF_STRIKETHROUGH: WordGetValue = wFont.StrikeThrough
+    Case T_FF_UNDERLINE: WordGetValue = wFont.Underline
+    Case T_FF_ALLCAPS: WordGetValue = wFont.AllCaps
+  End Select
+End Function
+
+Private Function WordSetValue(nFeature As TFormatFeature, ByRef target As Word.Font, iValue As Variant)
+  Select Case nFeature
+    Case T_FF_FONT_NAME: target.Name = iValue
+    Case T_FF_FONT_SIZE: target.Size = iValue
+    Case T_FF_BOLD: target.Bold = iValue
+    Case T_FF_ITALIC: target.Italic = iValue
+    Case T_FF_TEXT_COLOR: target.TextColor = iValue
+    Case T_FF_BG_COLOR: target.Shading.BackgroundPatternColor = iValue
+    Case T_FF_UNDERLINE_COLOR: target.UnderlineColor = iValue
+    Case T_FF_STRIKETHROUGH: target.StrikeThrough = iValue
+    Case T_FF_UNDERLINE: target.Underline = iValue
+    Case T_FF_ALLCAPS: target.AllCaps = iValue
+  End Select
+End Function
+

src/common/ItemConfigDescriptor.cls

@@ -0,0 +1,21 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ItemConfigDescriptor"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public name_$
+Public path_$
+
+Public Function Clone() As ItemConfigDescriptor
+  Set Clone = New ItemConfigDescriptor
+  With Clone
+    .name_ = name_
+    .path_ = path_
+  End With
+End Function

src/common/ItemFragment.cls

@@ -0,0 +1,37 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "ItemFragment"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public id_ As Long
+Public start_ As Long
+Public end_ As Long
+
+Public Function Init(catID&, nStart&, nEnd&)
+  id_ = catID
+  start_ = nStart
+  end_ = nEnd
+End Function
+
+Public Function Clone() As ItemFragment
+  Set Clone = New ItemFragment
+  With Clone
+    .start_ = start_
+    .end_ = end_
+    .id_ = id_
+  End With
+End Function
+
+Public Function Compare(rhs As Variant) As Double
+  Compare = id_ - rhs.id_
+  If Compare = 0 Then _
+    Compare = start_ - rhs.start_
+  If Compare = 0 Then _
+    Compare = end_ - rhs.end_
+End Function

src/common/IteratorFormat.cls

@@ -0,0 +1,45 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "IteratorFormat"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+' Èòåðàòîð íà îñíîâå àíàëèçà øðèôòîâîãî âûäåëåíèÿ
+Option Explicit
+
+Private selection_ As Word.Range
+Private format_ As InfoFormat
+
+Public Function Init(theDoc As Word.Document, iFormat As InfoFormat, Optional nStart& = 0)
+  Set format_ = iFormat
+  Set selection_ = theDoc.Range(nStart, nStart)
+End Function
+
+Public Function Range() As Word.Range
+  Set Range = selection_
+End Function
+
+Public Function MoveNext() As Word.Range
+  Set MoveNext = IIf(Increment(True), selection_, Nothing)
+End Function
+
+Public Function MovePrev() As Word.Range
+  Set MovePrev = IIf(Increment(False), selection_, Nothing)
+End Function
+
+' =========
+Private Function Increment(bForward As Boolean) As Boolean
+  Dim rSearch As Word.Range: Set rSearch = selection_.Duplicate
+  Call rSearch.Collapse(IIf(bForward, wdCollapseEnd, wdCollapseStart))
+  
+  Call format_.ApplyToWordFont(rSearch.Find.Font)
+  rSearch.Find.Format = True
+  rSearch.Find.Forward = bForward
+  Increment = rSearch.Find.Execute
+  If Increment Then _
+    Set selection_ = rSearch
+End Function
+

src/common/IteratorStyle.cls

@@ -0,0 +1,109 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "IteratorStyle"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+' Èòåðàòîð íà îñíîâå ïîèñêà ïî èìåíàì ñòèëåé
+Option Explicit
+
+Private selection_ As Word.Range
+Private styles_ As Collection
+
+Public Function Init(theDoc As Word.Document, searchWhat As Collection, Optional nStart& = 0)
+  Set styles_ = searchWhat
+  Set selection_ = theDoc.Range(nStart, nStart)
+End Function
+
+Public Function Range() As Word.Range
+  Set Range = selection_
+End Function
+
+Public Function MoveNext() As Word.Range
+  Set MoveNext = IIf(Increment(True), selection_, Nothing)
+End Function
+
+Public Function MovePrev() As Word.Range
+  Set MovePrev = IIf(Increment(False), selection_, Nothing)
+End Function
+
+' =========
+Private Function Increment(bForward As Boolean) As Boolean
+  Increment = False
+  If Not IncrementOnce(bForward) Then _
+    Exit Function
+  
+  Dim nStart&: nStart = selection_.Start
+  Dim nFinish&: nFinish = selection_.End
+  Do
+    Call IncrementOnce(bForward)
+    If selection_.Start <> nFinish Then _
+      Exit Do
+    nFinish = selection_.End
+  Loop
+  
+  Set selection_ = selection_.Document.Range(nStart, nFinish)
+  Increment = True
+End Function
+
+Private Function IncrementOnce(bForward As Boolean)
+  IncrementOnce = False
+  
+  Dim iFoundIntervals As New CDS_CompoundIntervals
+  Dim sStyle As Variant
+  For Each sStyle In styles_
+    Dim rOption As Word.Range: Set rOption = IncrementStyle(CStr(sStyle), bForward)
+    If Not rOption Is Nothing Then _
+      Call iFoundIntervals.AddItem(rOption.Start, rOption.End)
+  Next sStyle
+  If iFoundIntervals.IsEmpty Then _
+    Exit Function
+  
+  Dim iResult As CDS_Interval: Set iResult = iFoundIntervals.items_(1)
+  Dim rAlt As CDS_Interval
+  For Each rAlt In iFoundIntervals.items_
+    If bForward Then
+      If iResult.start_ > rAlt.start_ Then _
+        Set iResult = rAlt
+    Else
+      If iResult.finish_ < rAlt.finish_ Then _
+        Set iResult = rAlt
+    End If
+  Next rAlt
+  
+  Set selection_ = selection_.Document.Range(iResult.start_, iResult.finish_)
+  IncrementOnce = True
+End Function
+
+Private Function IncrementStyle(sStyle$, bForward As Boolean) As Word.Range
+  Dim theDoc As Word.Document: Set theDoc = selection_.Document
+  Dim rSearch As Word.Range: Set rSearch = selection_.Duplicate
+  Call rSearch.Collapse(IIf(bForward, wdCollapseEnd, wdCollapseStart))
+  
+  rSearch.Find.Forward = bForward
+  rSearch.Find.Style = sStyle
+  rSearch.Find.Format = True
+  If Not rSearch.Find.Execute Then _
+    Exit Function
+  
+  Set IncrementStyle = rSearch.Duplicate
+  If rSearch.End = theDoc.Range.End Then _
+    Exit Function
+  
+  
+  If theDoc.Range(rSearch.End, rSearch.End + 1).Text <> "" Then _
+    Exit Function
+    
+  Call rSearch.Collapse(IIf(bForward, wdCollapseEnd, wdCollapseStart))
+  If Not rSearch.Find.Execute Then _
+    Exit Function
+    
+  If rSearch.Start = IncrementStyle.End + 1 Then _
+    IncrementStyle.End = rSearch.End
+End Function
+
+
+

src/common/MU_Declarations.bas

@@ -0,0 +1,65 @@
+Attribute VB_Name = "MU_Declarations"
+' Äåêëàðàöèè ìîäóëÿ ðàçìåòêè
+' Ñîñòàâ API ìîäóëÿ: âñå ìîäóëè ñ ïðåôèêñîì MU_ è MarkupAPI
+Option Private Module
+Option Explicit
+
+Public Const VAR_MUPATH = "MarkupConfig"
+Public Const VAR_HASH = "MarkupHash"
+
+Public Const CONFIG_PATH = "\Microsoft\Øàáëîíû\Ðàçìåòêà\"
+Public Const CONFIG_MASK = "*.docx"
+
+Public Const WORD_FIRST_ROW = 2
+
+Public Const WORD_CAT_ID = 1
+Public Const WORD_CAT_NAME = 2
+Public Const WORD_CAT_STYLE = 3
+Public Const WORD_CAT_INFO = 4
+Public Const WORD_CAT_COMP = 5
+
+Public Const SPLITTER_COMPOSITION = ";"
+Public Const INFO_GENERATED = "GENERATED"
+
+Public Enum OutExcelStruct
+  OES_ID = 1
+  OES_START = 2
+  OES_FINISH = 3
+  OES_TYPE = 4
+  OES_TEXT = 5
+  OES_COMMENT = 6
+  OES_SOURCE_LABEL = 7
+  OES_SOURCE = 8
+End Enum
+
+' Markup errors
+Public Enum MUErrors
+  ERR_COMBO_TAKEN = vbObjectError + 1000
+  ERR_CANNOT_ADD_STYLE
+  ERR_STYLE_TAKEN
+  ERR_FORMAT_TAKEN
+  ERR_UNKNOWN_CAT_ID
+  ERR_CAT_NAME_TAKEN
+  ERR_STYLE_NO_FORMAT
+  ERR_INCOMPLETE_COMPOSITION
+End Enum
+
+Public Function Markup() As MarkupAPI
+  Static globalMarkup As New MarkupAPI
+  Set Markup = globalMarkup
+End Function
+
+Public Function GetConfigList() As Collection
+  Set GetConfigList = New Collection
+  
+  Dim fso As New Scripting.FileSystemObject
+  Dim desc As New ItemConfigDescriptor
+  Dim sFolder$: sFolder = VBA.Environ("AppData") & CONFIG_PATH
+  Dim sFile$: sFile = sFolder & VBA.Dir(sFolder & CONFIG_MASK)
+  Do While sFile <> sFolder
+    desc.path_ = sFile
+    desc.name_ = fso.GetBaseName(desc.path_)
+    Call GetConfigList.Add(desc.Clone())
+    sFile = sFolder & VBA.Dir
+  Loop
+End Function

src/common/MarkupAPI.cls

@@ -0,0 +1,87 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "MarkupAPI"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+'================ API ïðîöåññà ðàçìåòêè =========================
+Option Explicit
+
+Public config_ As InfoConfig
+
+Private Sub Class_Initialize()
+  Set config_ = New InfoConfig
+End Sub
+
+Public Function LoadConfig(sConfig$) As Boolean
+  LoadConfig = config_.Load(sConfig)
+End Function
+
+Public Function InitFromCurrentDocument(target As Word.Document) As Boolean
+  InitFromCurrentDocument = False
+  
+  Dim sConfig$: sConfig = GetMetadata(target, VAR_MUPATH)
+  If sConfig = "" Then _
+    Exit Function
+    
+  InitFromCurrentDocument = LoadConfig(sConfig)
+  If InitFromCurrentDocument Then
+    Call config_.SyncDocument(target)
+  Else
+    Call SetMetadata(target, VAR_MUPATH, "")
+    Call SetMetadata(target, VAR_HASH, "")
+  End If
+End Function
+
+Public Function ValidateConfig(styleDoc As Word.Document) As String
+  Dim sLog$
+  Dim errCount&
+  Dim iCat As InfoCategory
+  Dim catID As Variant
+  For Each catID In config_.categories_
+    Set iCat = config_.categories_(catID)
+    If Not iCat.IsComplete Then
+      errCount = errCount + 1
+      sLog = sLog & "Êàòåãîðèÿ áåç ñòèëÿ: " & iCat.name_ & vbNewLine
+    Else
+      errCount = errCount + CheckStyleSimilarity(sLog, iCat, styleDoc)
+    End If
+  Next catID
+  
+  If errCount = 0 Then
+    ValidateConfig = "Êîíôèãóðàöèÿ ðàçìåòêè êîððåòêíà"
+  Else
+    ValidateConfig = "Íàéäåíû îøèáêè" & vbNewLine & VBA.Right(sLog, VBA.Len(sLog) - 1)
+  End If
+End Function
+
+Public Function SyncWord(target As Word.Document) As Boolean
+  SyncWord = False
+  If Not config_.IsLoaded Then _
+    Exit Function
+  
+  Call config_.SyncDocument(target)
+
+  SyncWord = True
+End Function
+
+' ===========
+Private Function CheckStyleSimilarity(ByRef sLog$, iCat1 As InfoCategory, styleDoc As Word.Document) As Long
+  Dim iCat2 As InfoCategory
+  Dim catID As Variant
+  For Each catID In config_.categories_
+    Set iCat2 = config_.categories_(catID)
+    If iCat2.style_ = "" Or iCat1.id_ = iCat2.id_ Then _
+      GoTo NEXT_CAT
+    
+    Dim frs As New InfoFormat: Call frs.InitFromWordDiff(styleDoc.Styles(iCat1.style_), styleDoc.Styles(iCat2.style_))
+    If frs.IsEmpty Then
+      CheckStyleSimilarity = CheckStyleSimilarity + 1
+      sLog = sLog & "Äóáëèðóþùèåñÿ ñòèëè: " & iCat1.style_ & " == " & iCat2.style_ & vbNewLine
+    End If
+NEXT_CAT:
+  Next catID
+End Function

src/markup/Declarations.bas

@@ -0,0 +1,8 @@
+Attribute VB_Name = "Declarations"
+Option Explicit
+
+Public Const APP_HELP = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\01 Âûñîêèå òåõíîëîãèè\Êîíöåïò-Ðàçìåòêà\!Ðóêîâîäñòâî ïîëüçîâàòåëÿ.docx"
+
+Public Const TEMP_FILE_NAME = "conceptMarkup"
+
+Public Const DATA_ROW_START = 2

src/markup/DevHelper.bas

@@ -0,0 +1,52 @@
+Attribute VB_Name = "DevHelper"
+Option Explicit
+
+Private Const TEST_SOURCES = "test"
+Private Const TEST_CONFIG = "TestConfig.docx"
+
+Private Const TEST_FILES = "testFiles"
+
+Public Function Dev_PrepareSkeleton()
+  ' Do nothing
+End Function
+
+Public Sub Dev_ManualRunTest()
+  Dim sSuite$: sSuite = "s_WordDocument"
+  Dim sTest$: sTest = "t_AddCategory"
+  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_WordDocument": Set Dev_GetTestSuite = New s_WordDocument
+    Case "s_MarkupAPI": Set Dev_GetTestSuite = New s_MarkupAPI
+    Case "s_Format": Set Dev_GetTestSuite = New s_Format
+    Case "s_Category": Set Dev_GetTestSuite = New s_Category
+    Case "s_Config": Set Dev_GetTestSuite = New s_Config
+  End Select
+End Function
+
+Public Function GetTestFolder() As String
+  Dim fso As New Scripting.FileSystemObject
+  GetTestFolder = fso.GetParentFolderName(ThisDocument.Path)
+  GetTestFolder = GetTestFolder & "\" & TEST_FILES
+End Function
+
+Public Function ResetTestFolder()
+  Dim sFolder$: sFolder = GetTestFolder
+  Dim fso As New Scripting.FileSystemObject
+  On Error Resume Next
+  Call fso.DeleteFolder(sFolder)
+  On Error GoTo 0
+  Call EnsureFolderExists(sFolder, fso)
+End Function
+
+Public Function SetupTestConfig() As String
+  Dim fso As New Scripting.FileSystemObject
+  Dim sSource$: sSource = fso.GetParentFolderName(ThisDocument.Path) & "\" & TEST_SOURCES & "\" & TEST_CONFIG
+  Dim sTest$: sTest = GetTestFolder & "\" & TEST_CONFIG
+  Call fso.CopyFile(sSource, sTest)
+  SetupTestConfig = sTest
+End Function

src/markup/Main.bas

@@ -0,0 +1,331 @@
+Attribute VB_Name = "Main"
+Option Explicit
+
+Public Sub MU_OpenConfig()
+  If Not PreloadConfig Then _
+    Exit Sub
+  If Not UserInteraction.AskQuestion(QM_CONFIG_EDIT_CONFIRM) Then _
+    Exit Sub
+  Dim iShell As New Shell32.Shell
+  Call iShell.Open(Markup.config_.sourcePath_)
+End Sub
+
+Public Sub MU_SyncStyles()
+  If Not PreloadConfig Then _
+    Exit Sub
+  Call Markup.config_.SyncStyles(ThisDocument.Application, ActiveDocument.FullName)
+  Call UserInteraction.ShowMessage(IM_STYLES_UPDATE_SUCCESS)
+End Sub
+
+Public Sub MU_LoadConfig()
+  Dim sFile$: sFile = UserInteraction.PromptFile(ActiveDocument.Path)
+  If sFile = vbNullString Then _
+    Exit Sub
+  Call MU_LoadConfigFrom(sFile)
+  Call UIUpdateConfigList
+End Sub
+
+Public Function MU_LoadConfigFrom(sFile$) As Boolean
+  If Not Markup.config_.Load(sFile) Then
+    Call UserInteraction.ShowMessage(EM_EXPORT_CONFIG_FAIL)
+    MU_LoadConfigFrom = False
+  Else
+    Call UIResetCategories
+    MU_LoadConfigFrom = True
+  End If
+End Function
+
+Public Sub MU_DetermineCategory()
+ If Not PreloadConfig Then _
+    Exit Sub
+    
+  Dim iCat As InfoCategory: Set iCat = Markup.config_.FindStyle(Selection.Style)
+  If iCat Is Nothing Then
+    Call UserInteraction.ShowMessage(IM_NO_CATEGORY)
+  Else
+    Call UserInteraction.ShowMessage(IM_CATEGORY_OUT, iCat.id_, iCat.name_)
+  End If
+End Sub
+
+Public Sub MU_ApplyCategory()
+  If Not PreloadConfig Then _
+    Exit Sub
+  Dim iCat As InfoCategory: Set iCat = ActiveCategory
+  If iCat Is Nothing Then _
+    Exit Sub
+  
+  Dim iDoc As InfoDocument: Set iDoc = GetActiveWrapper
+  Dim rSelection As Word.Range: Set rSelection = WordAdjustRange(Selection.Range)
+  If iDoc.ApplyCategory(iCat, rSelection) Then _
+    Call rSelection.Select
+End Sub
+
+Public Sub MU_AddCategory()
+  If Not PreloadConfig Then _
+    Exit Sub
+  Dim iCat As InfoCategory: Set iCat = ActiveCategory
+  If iCat Is Nothing Then _
+    Exit Sub
+  
+  Dim iDoc As InfoDocument: Set iDoc = GetActiveWrapper
+  Dim rSelection As Word.Range: Set rSelection = WordAdjustRange(Selection.Range)
+  If iDoc.AddCategory(iCat, rSelection) Then
+    Call rSelection.Select
+    Call UIUpdateCategories
+  Else
+    Call UserInteraction.ShowMessage(EM_CANNOT_COMBINE_STYLES)
+  End If
+End Sub
+
+Public Sub MU_ClearFragment()
+  Dim tRange As Word.Range: Set tRange = Selection.Range.Duplicate
+  Dim iDoc As New InfoDocument:  Call iDoc.Init(ActiveDocument, Markup)
+  Set tRange = WordAdjustRange(tRange)
+  tRange.Style = wdStyleDefaultParagraphFont
+  Call tRange.Select
+End Sub
+
+Sub MU_NextCategory()
+  If Not PreloadConfig Then _
+    Exit Sub
+  Call UINextCat
+End Sub
+
+Sub MU_PrevCategory()
+  If Not PreloadConfig Then _
+    Exit Sub
+  Call UIPrevCat
+End Sub
+
+Public Sub MU_GotoNext()
+  If Not PreloadConfig Then _
+    Exit Sub
+  Dim iCat As InfoCategory: Set iCat = ActiveCategory
+  If iCat Is Nothing Then _
+    Exit Sub
+  
+  Dim iter As IteratorFormat: Set iter = GetActiveWrapper.GetFormatIterator(iCat.id_, Selection.End)
+  Dim rFound As Word.Range: Set rFound = iter.MoveNext
+  If Not rFound Is Nothing Then _
+    Call rFound.Select
+End Sub
+
+Public Sub MU_GotoPrev()
+  If Not PreloadConfig Then _
+    Exit Sub
+  Dim iCat As InfoCategory: Set iCat = ActiveCategory
+  If iCat Is Nothing Then _
+    Exit Sub
+  
+  Dim iter As IteratorFormat: Set iter = GetActiveWrapper.GetFormatIterator(iCat.id_, Selection.Start)
+  Dim rFound As Word.Range: Set rFound = iter.MovePrev
+  If Not rFound Is Nothing Then _
+    Call rFound.Select
+End Sub
+
+Public Sub MU_HideText()
+  If Not PreloadConfig Then _
+    Exit Sub
+  Dim iCat As InfoCategory: Set iCat = ActiveCategory
+  If iCat Is Nothing Then _
+    Exit Sub
+  
+  Dim wUI As New API_WordWrapper: Call wUI.SetDocument(ActiveDocument)
+  Call wUI.PauseUI
+  Call GetActiveWrapper.SetCategoryVisible(iCat.id_, False)
+  Call wUI.ResumeUI
+End Sub
+
+Public Sub MU_ShowText()
+  If Not PreloadConfig Then _
+    Exit Sub
+  Dim iCat As InfoCategory: Set iCat = ActiveCategory
+  If iCat Is Nothing Then _
+    Exit Sub
+  
+  Dim wUI As New API_WordWrapper: Call wUI.SetDocument(ActiveDocument)
+  Call wUI.PauseUI
+  Call GetActiveWrapper.SetCategoryVisible(iCat.id_, True)
+  Call wUI.ResumeUI
+End Sub
+
+Public Sub MU_HighlightText()
+  If Not PreloadConfig Then _
+    Exit Sub
+  Dim iCat As InfoCategory: Set iCat = ActiveCategory
+  If iCat Is Nothing Then _
+    Exit Sub
+  
+  Dim wUI As New API_WordWrapper: Call wUI.SetDocument(ActiveDocument)
+  Call wUI.PauseUI
+  Call GetActiveWrapper.SetCategoryHighlight(iCat.id_, True)
+  Call wUI.ResumeUI
+End Sub
+
+Public Sub MU_UnhighlightText()
+  If Not PreloadConfig Then _
+    Exit Sub
+  Dim iCat As InfoCategory: Set iCat = ActiveCategory
+  If iCat Is Nothing Then _
+    Exit Sub
+  
+  Dim wUI As New API_WordWrapper: Call wUI.SetDocument(ActiveDocument)
+  Call wUI.PauseUI
+  Call GetActiveWrapper.SetCategoryHighlight(iCat.id_, False)
+  Call wUI.ResumeUI
+End Sub
+
+Public Sub MU_ExtractVisible()
+  Dim iSource As Word.Document: Set iSource = ActiveDocument
+  
+  Dim wrapper As New API_WordWrapper
+  Dim iDestination As Word.Document: Set iDestination = wrapper.NewDocument
+  If iDestination Is Nothing Then _
+    Exit Sub
+    
+  Call TransferVisible(iSource, iDestination)
+  
+  Call UserInteraction.ShowMessage(IM_EXPORT_VISIBLE_SUCCESS)
+End Sub
+
+Public Sub MU_ExtractCategory()
+  If Not PreloadConfig Then _
+    Exit Sub
+
+  Dim iCat As InfoCategory: Set iCat = ActiveCategory
+  If iCat Is Nothing Then _
+    Exit Sub
+  
+  Dim wrapper As New API_WordWrapper
+  Dim iDestination As Word.Document: Set iDestination = wrapper.NewDocument
+  If iDestination Is Nothing Then _
+    Exit Sub
+  
+  Dim iter As IteratorFormat: Set iter = GetActiveWrapper.GetFormatIterator(iCat.id_)
+  Do While Not iter.MoveNext Is Nothing
+    Call iter.Range.Copy
+    Call iDestination.Range.InsertAfter(vbNewLine)
+    Call iDestination.Paragraphs.Last.Range.Paste
+  Loop
+  
+  Call UserInteraction.ShowMessage(IM_EXPORT_CATEGORY_SUCCESS)
+End Sub
+
+Public Sub MU_ExportMarkup()
+  If Not PreloadConfig Then _
+    Exit Sub
+  
+  Dim iDoc As InfoDocument: Set iDoc = GetActiveWrapper
+
+  Dim outName$: outName = ActiveDocument.FullName & "_export" & ".txt"
+  Dim fso As New Scripting.FileSystemObject
+  Dim textOut As Object: Set textOut = fso.CreateTextFile(outName, True)
+
+  Dim frags As Collection: Set frags = iDoc.GetAllFragments()
+  Dim aFrag As ItemFragment
+  For Each aFrag In frags
+    Call textOut.WriteLine(CStr(aFrag.start_) & vbTab & CStr(aFrag.end_) & vbTab & aFrag.id_)
+  Next aFrag
+  
+  Call textOut.Close
+  
+  Dim oShell As New Shell32.Shell
+  Call oShell.Open(outName)
+End Sub
+
+Public Sub MU_ImportMarkup()
+  If Not PreloadConfig Then _
+    Exit Sub
+    
+  Dim sFile$: sFile = UserInteraction.PromptFile(ActiveDocument.Path)
+  If sFile = "" Then _
+    Exit Sub
+  Dim fragments As Collection: Set fragments = ScanFragmentsFrom(sFile)
+  If fragments Is Nothing Then _
+    Exit Sub
+  
+  Dim iDoc As InfoDocument: Set iDoc = GetActiveWrapper
+  If iDoc.ApplyFragments(fragments) Then
+    Call UserInteraction.ShowMessage(IM_IMPORT_SUCCESS)
+  Else
+    Call UserInteraction.ShowMessage(EM_IMPORT_FAIL)
+  End If
+End Sub
+
+Public Sub MU_ExportMarkedText()
+  If Not PreloadConfig Then _
+    Exit Sub
+  
+  Dim iDoc As InfoDocument: Set iDoc = GetActiveWrapper
+  
+  Dim xlApp As New API_XLWrapper
+  Dim outWB As Excel.Workbook: Set outWB = xlApp.NewDocument
+  If outWB Is Nothing Then
+    Call UserInteraction.ShowMessage(EM_FAILED_OUTPUT_CREATION)
+    Exit Sub
+  End If
+  
+  Dim frags As Collection: Set frags = iDoc.GetBasicFragmentsCompound()
+  
+  Call CSE_ProgressBar.Init("Âûãðóçêà äàííûõ", maxVal:=frags.Count)
+  Call CSE_ProgressBar.Show
+
+  Call xlApp.PauseUI
+  Call Output2Excel(outWB, frags)
+  Call xlApp.ResumeUI
+  
+  Call Unload(CSE_ProgressBar)
+  
+  Call UserInteraction.ShowMessage(IM_EXCEL_OUT_SUCCESS)
+End Sub
+
+Public Sub MU_ExportHighlights()
+  Dim outName$: outName = ActiveDocument.FullName & "_export" & ".txt"
+  Dim fso As New Scripting.FileSystemObject
+  Dim textOut As Object: Set textOut = fso.CreateTextFile(outName, True)
+  
+  Dim iDoc As New InfoDocument: Call iDoc.Init(ActiveDocument, Markup)
+  Dim frags As Collection: Set frags = iDoc.GetAllHighlights()
+  Dim aFrag As ItemFragment
+  For Each aFrag In frags
+    Call textOut.WriteLine(CStr(aFrag.start_) & vbTab & CStr(aFrag.end_) & vbTab & aFrag.id_)
+  Next aFrag
+  
+  Call textOut.Close
+  
+  Dim oShell As New Shell32.Shell
+  Call oShell.Open(outName)
+End Sub
+
+Public Sub MU_ViewHelp()
+  Dim aWrap As New API_WordWrapper
+  Dim helpDoc As Word.Document: Set helpDoc = aWrap.OpenDocument(APP_HELP, bReadOnly:=True)
+  If helpDoc Is Nothing Then _
+    Exit Sub
+    
+  helpDoc.ActiveWindow.View.ReadingLayout = False
+  Call helpDoc.Activate
+End Sub
+
+' =======
+Private Function GetActiveWrapper() As InfoDocument
+  Dim iDoc As New InfoDocument: Call iDoc.Init(ActiveDocument, Markup)
+  Call iDoc.SyncStyles
+  Set GetActiveWrapper = iDoc
+End Function
+
+Private Function PreloadConfig() As Boolean
+  PreloadConfig = False
+  
+  If Not Markup.config_.IsLoaded Then
+    If Not Markup.InitFromCurrentDocument(ActiveDocument) Then
+      Call UserInteraction.ShowMessage(EM_CONFIG_LOAD_FAIL)
+      Exit Function
+    Else
+      Call UIUpdateConfigList
+      Call UIResetCategories
+    End If
+  End If
+  
+  PreloadConfig = True
+End Function

src/markup/MainImpl.bas

@@ -0,0 +1,119 @@
+Attribute VB_Name = "MainImpl"
+Option Explicit
+
+Public Function Output2Excel(outWB As Excel.Workbook, frags As Collection)
+  Dim dataSht As Excel.Worksheet: Set dataSht = outWB.Worksheets(1)
+  Call InitOutputHeader(dataSht)
+  Dim iPath As New API_Path: Call iPath.FromString(ActiveDocument.FullName)
+  
+  dataSht.Cells(2, OES_SOURCE_LABEL) = "Èñòî÷íèê"
+  dataSht.Cells(2, OES_SOURCE) = iPath.GlobalToServer.Text
+  
+  Dim aFrag As ItemFragment
+  Dim nRow&: nRow = DATA_ROW_START
+  For Each aFrag In frags
+    Dim theRange As Word.Range: Set theRange = ActiveDocument.Range(aFrag.start_, aFrag.end_)
+    
+    dataSht.Cells(nRow, OES_ID) = nRow - 1
+    dataSht.Cells(nRow, OES_START) = CStr(theRange.Start)
+    dataSht.Cells(nRow, OES_FINISH) = CStr(theRange.End)
+    dataSht.Cells(nRow, OES_TYPE) = CStr(aFrag.id_)
+    dataSht.Cells(nRow, OES_TEXT) = theRange.Text
+    dataSht.Cells(nRow, OES_COMMENT) = ExtractCommentText(theRange)
+    
+    nRow = nRow + 1
+    Call CSE_ProgressBar.IncrementA
+  Next aFrag
+  
+  On Error Resume Next
+  Call dataSht.Columns("A:F").Sort(key1:=dataSht.Range("B2"), order1:=xlAscending, key2:=dataSht.Range("C2"), order2:=xlDescending, Header:=xlYes)
+  On Error GoTo 0
+End Function
+
+Public Function TransferVisible(iSource As Word.Document, iDestination As Word.Document)
+  Call iSource.Range.Copy
+  Call iDestination.Paragraphs.Add
+  Dim nStart&: nStart = iDestination.Paragraphs.Last.Range.Start
+  Call iDestination.Paragraphs.Last.Range.Paste
+  
+  Dim rFind As Word.Range: Set rFind = iDestination.Range
+  rFind.Start = nStart
+  Call rFind.Find.ClearFormatting
+  Call rFind.Find.Replacement.ClearFormatting
+  With rFind.Find
+    .Font.Hidden = True
+    .MatchWildcards = True
+    .Text = "*"
+    .Replacement.Text = ""
+    .Forward = True
+    Call .Execute(Replace:=wdReplaceAll)
+  End With
+End Function
+
+Public Function ScanFragmentsFrom(sFile$) As Collection
+  Dim fso As New Scripting.FileSystemObject
+  If VBA.LCase(fso.GetExtensionName(sFile)) = "txt" Then
+    Set ScanFragmentsFrom = ScanTextFile(sFile)
+  Else
+    Set ScanFragmentsFrom = ScanXLFile(sFile)
+  End If
+End Function
+
+' =====
+Private Function InitOutputHeader(target As Excel.Worksheet)
+  target.Cells(1, OES_ID) = "ID"
+  target.Cells(1, OES_START) = "Íà÷àëî"
+  target.Cells(1, OES_FINISH) = "Êîíåö"
+  target.Cells(1, OES_TYPE) = "Òèï"
+  target.Cells(1, OES_TEXT) = "Òåêñò"
+  target.Cells(1, OES_COMMENT) = "Êîììåíòàðèé"
+End Function
+
+Private Function ScanTextFile(sFile$) As Collection
+  Dim fso As New Scripting.FileSystemObject
+  Dim textIn As Object: Set textIn = fso.OpenTextFile(sFile)
+  If textIn Is Nothing Then _
+    Exit Function
+  
+  Dim fragments As New Collection
+  Dim frag As New ItemFragment
+  While Not textIn.AtEndOfStream
+    Dim text_line$: text_line = textIn.ReadLine
+    If text_line = vbNullString Then _
+      GoTo EXIT_LOOP
+
+    Dim elemArray() As String: elemArray = VBA.Split(text_line, vbTab)
+    frag.start_ = CLng(elemArray(0))
+    frag.end_ = CLng(elemArray(1))
+    frag.id_ = elemArray(2)
+    Call fragments.Add(frag.Clone)
+  Wend
+EXIT_LOOP:
+  Call textIn.Close
+  Set ScanTextFile = fragments
+End Function
+
+Private Function ScanXLFile(sFile$) As Collection
+  Dim xlApp As New API_XLWrapper
+  If xlApp.OpenDocument(sFile, bReadOnly:=True) Is Nothing Then _
+    Exit Function
+  
+  On Error GoTo SAFE_EXIT
+  Dim fragments As New Collection
+  Dim frag As New ItemFragment
+  Dim iData As Excel.Worksheet: Set iData = xlApp.Document.Sheets(1)
+  Dim nRow&: nRow = DATA_ROW_START
+  Do While iData.Cells(nRow, OES_ID) <> vbNullString
+    frag.start_ = iData.Cells(nRow, OES_START)
+    frag.end_ = iData.Cells(nRow, OES_FINISH)
+    frag.id_ = iData.Cells(nRow, OES_TYPE)
+    Call fragments.Add(frag.Clone)
+    nRow = nRow + 1
+  Loop
+  On Error GoTo 0
+  
+SAFE_EXIT:
+  Call xlApp.ReleaseDocument
+  Set ScanXLFile = fragments
+End Function
+

src/markup/z_UIMessages.bas

@@ -0,0 +1,121 @@
+Attribute VB_Name = "z_UIMessages"
+' Messaging module
+Option Private Module
+Option Explicit
+
+Public Enum MsgCode
+  EM_COMBO_TAKEN = ERR_COMBO_TAKEN
+  EM_CANNOT_ADD_STYLE = ERR_CANNOT_ADD_STYLE
+  EM_STYLE_TAKEN = ERR_STYLE_TAKEN
+  EM_FORMAT_TAKEN = ERR_FORMAT_TAKEN
+  EM_UNKNOWN_CAT_ID = ERR_UNKNOWN_CAT_ID
+  EM_CAT_NAME_TAKEN = ERR_CAT_NAME_TAKEN
+  EM_STYLE_NO_FORMAT = ERR_STYLE_NO_FORMAT
+  EM_INCOMPLETE_COMPOSITION = ERR_INCOMPLETE_COMPOSITION
+
+  EM_EXPORT_CONFIG_FAIL = 1
+  EM_FAILED_OUTPUT_CREATION
+  EM_IMPORT_FAIL
+  EM_CONFIG_LOAD_FAIL
+  EM_CANNOT_COMBINE_STYLES
+  EM_CONFIG_MISSING
+  EM_ID_NOT_SELECTED
+  EM_STYLE_NOT_SELECTED
+  EM_CATEGORY_NOT_SELECTED
+  EM_RIBBON_NOT_REACHABLE
+  EM_VALIDATION_FAILED
+  EM_CATEGORY_INVALID
+  EM_COMBO_VALIDATION_FAILED
+  EM_COMBO_MISSING_TEXT
+ 
+  IM_EXPORT_VISIBLE_SUCCESS
+  IM_EXPORT_CATEGORY_SUCCESS
+  IM_IMPORT_SUCCESS
+  IM_EXCEL_OUT_SUCCESS
+  IM_STYLES_UPDATE_SUCCESS
+  IM_NO_CATEGORY
+  IM_CATEGORY_OUT
+  
+  QM_CONFIG_EDIT_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 ProcessErrorMessages(expectedErrors As Scripting.Dictionary)
+  If Err.Number = 0 Then _
+    Exit Function
+    
+  Call Unload(CSE_ProgressBar)
+  If Not expectedErrors.Exists(Err.Number) Then _
+    Call Err.Raise(Err.Number)
+  
+  Call UserInteraction.ShowMessage(Err.Number, Err.Source)
+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_EXPORT_CONFIG_FAIL:       Call MsgBox("Íå óäàëîñü çàãðóçèòü êîíôèãóðàöèþ èç ôàéëà", vbExclamation)
+    Case EM_FAILED_OUTPUT_CREATION:   Call MsgBox("Íå óäàëîñü ñîçäàòü ôàéë äëÿ âûãðóçêè òåêñòîâ", vbExclamation)
+    Case EM_IMPORT_FAIL:              Call MsgBox("Äàííîå îïèñàíèå ðàçìåòêè íå ñîâìåñòèìî ñ êîíôèãóðàöèåé", vbInformation)
+    Case EM_CONFIG_LOAD_FAIL:         Call MsgBox("Êîíôèãóðàöèÿ íå çàãðóæåíà", vbExclamation)
+    Case EM_CANNOT_COMBINE_STYLES:    Call MsgBox("Íåîïðåäåëåííàÿ êîìáèíàöèÿ ñòèëåé", vbExclamation)
+    Case EM_CONFIG_MISSING:           Call MsgBox("Êîíôèãóðàöèÿ îòñóòñòâóåò", vbExclamation)
+    Case EM_ID_NOT_SELECTED:          Call MsgBox("Íå âûáðàí èäåíòèôèêàòîð", vbExclamation)
+    Case EM_STYLE_NOT_SELECTED:       Call MsgBox("Âûáåðèòå ñòèëü!", vbExclamation)
+    Case EM_CATEGORY_NOT_SELECTED:    Call MsgBox("Êàòåãîðèÿ íå âûáðàíà", vbExclamation)
+    Case EM_CATEGORY_INVALID:         Call MsgBox("Íåêîððåêòíûé èäåíòèôèêàòîð, îáðàòèòåñü ê ðàçðàáîò÷èêó", vbExclamation)
+    Case EM_VALIDATION_FAILED:        Call MsgBox("Çàïîëíèòå âñå òåêñòîâûå ïîëÿ", vbExclamation)
+    Case EM_COMBO_VALIDATION_FAILED:  Call MsgBox("Âûáåðèòå îáà èäåíòèôèêàòîðà äëÿ ñî÷åòàíèÿ", vbExclamation)
+    Case EM_COMBO_MISSING_TEXT:       Call MsgBox("Çàïîëíèòå íàçâàíèå êîìáèíàöèè è ñòèëÿ", vbExclamation)
+    Case EM_COMBO_TAKEN:              Call MsgBox(Fmt("Òàêîå ñî÷åòàíèå óæå îïðåäåëåíî. Åãî èäåíòèôèêàòîð: {1}", unwrapped), vbExclamation)
+    Case EM_CANNOT_ADD_STYLE:         Call MsgBox("Îøèáêà ïðè ñîçäàíèè ñòèëÿ", vbExclamation)
+    Case EM_STYLE_TAKEN:              Call MsgBox("Ñòèëü óæå èñïîëüçóåòñÿ äëÿ äðóãîé êàòåãîðèè", vbExclamation)
+    Case EM_FORMAT_TAKEN:             Call MsgBox(Fmt("Òàêîé ôîðìàò óæå îïðåäåëåí. Åãî èäåíòèôèêàòîð: {1}", unwrapped), vbExclamation)
+    Case EM_UNKNOWN_CAT_ID:           Call MsgBox("Íåèçâåñòíûé èäåíòèôèêàòîð êàòåãîðèè", vbExclamation)
+    Case EM_CAT_NAME_TAKEN:           Call MsgBox(Fmt("Èìÿ êàòåãîðèè çàíÿòî: {1}", unwrapped), vbExclamation)
+    Case EM_STYLE_NO_FORMAT:          Call MsgBox(Fmt("Âûáðàííûé ñòèëü íå ïîäõîäèò äëÿ ôîðìàòèðîâàíèÿ: {1}", unwrapped), vbExclamation)
+    Case EM_INCOMPLETE_COMPOSITION:   Call MsgBox("Êîìáèíàöèÿ ôîðìàòèðîâàíèÿ íå îïðåäåëåíà", vbExclamation)
+    Case EM_RIBBON_NOT_REACHABLE
+      Call MsgBox("Íå óäàëîñü âîññòàíîâèòü ñâÿçü ñ ëåíòîé!" & vbNewLine & _
+                  "Ïîæàëóéñòà, çàêðîéòå âñå îêíà Word äëÿ âîññòàíîâëåíèÿ êîððåêòíîé ðàáîòû è ñîîáùèòå ðàçðàáîò÷èêó", vbExclamation)
+      
+    Case IM_EXPORT_VISIBLE_SUCCESS:   Call MsgBox("Âûãðóçêà âèäèìûõ ôðàãìåíòîâ òåêñòà çàâåðøåíà", vbInformation)
+    Case IM_EXPORT_CATEGORY_SUCCESS:  Call MsgBox("Âûãðóçêà ôðàãìåíòîâ òåêñòà äàííîé êàòåãîðèè çàâåðøåíà", vbInformation)
+    Case IM_IMPORT_SUCCESS:           Call MsgBox("Èìïîðò çàâåðøåí óñïåøíî", vbInformation)
+    Case IM_EXCEL_OUT_SUCCESS:        Call MsgBox("Âûãðóçêà ïðîèçâåäåíà óñïåøíî", vbInformation)
+    Case IM_STYLES_UPDATE_SUCCESS:    Call MsgBox("Ñòèëè îáíîâëåíû", vbInformation)
+    Case IM_NO_CATEGORY:              Call MsgBox("Äëÿ äàííîãî ôðàãìåíòà êàòåãîðèÿ òåêñòà íå îïðåäåëåíà", vbInformation)
+    Case IM_CATEGORY_OUT:             Call MsgBox(Fmt("Øðèôòîâîå âûäåëåíèå óæå èñïîëüçóåòñÿ: {1}", unwrapped), 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_CONFIG_EDIT_CONFIRM
+    answer = MsgBox("Âíèìàíèå! Âû íà÷èíàåòå èçìåíåíèå ëîêàëüíîé êîíôèãóðàöèè ðàçìåòêè. Ýòè èçìåíåíèÿ íå áóäóò îòðàæàòüñÿ äëÿ äðóãèõ ïîëüçîâàòåëåé" & _
+      vbNewLine & "Äëÿ èçìåíåíèÿ ñåðâåðíîé êîíôèãóðàöèè îáðàòèòåñü ê ðàçðàáîò÷èêó", vbYesNo + vbQuestion)
+    
+  Case Else
+    Call MsgBox("Invalid message code", vbCritical)
+  End Select
+  UIAskQuestion = answer = vbYes
+End Function

src/markup/z_UIRibbon.bas

@@ -0,0 +1,210 @@
+Attribute VB_Name = "z_UIRibbon"
+' Îáðàáîòêà íàæàòèé íà êíîïêè â ðèááîíå
+Option Explicit
+
+Global g_RibbonWrap As API_Ribbon
+
+Global g_ActiveCat As Long
+Global g_Configs As New Collection
+
+Public Function RibbonTempFile() As String
+  RibbonTempFile = Environ("TEMP") & "/" & TEMP_FILE_NAME & CStr(GetCurrentProcessId) & ".txt"
+End Function
+
+Public Function ActiveCategory() As InfoCategory
+  If g_ActiveCat = 0 Then
+    Call UserInteraction.ShowMessage(EM_CATEGORY_NOT_SELECTED)
+    Exit Function
+  End If
+  
+  Set ActiveCategory = Markup.config_.GetAt(g_ActiveCat)
+  If ActiveCategory Is Nothing Then
+    Call UserInteraction.ShowMessage(EM_CATEGORY_INVALID)
+    Exit Function
+  End If
+End Function
+
+Public Function UINextCat()
+  If Markup.config_.categories_.Count = 0 Then _
+    Exit Function
+  
+  Dim catID As Variant
+  Dim nIndex&: nIndex = 0
+  Dim ids() As Variant: ids = Markup.config_.categories_.Keys()
+  For Each catID In ids
+    If g_ActiveCat = catID Then
+      If nIndex + 1 <> ArraySize(ids) Then
+        g_ActiveCat = ids(nIndex + 1)
+      Else
+        g_ActiveCat = ids(0)
+      End If
+      Exit For
+    End If
+    nIndex = nIndex + 1
+  Next catID
+  
+  Call UIUpdateCategories
+End Function
+
+Public Function UIPrevCat()
+  Dim catID As Variant
+  Dim nIndex&: nIndex = 0
+  Dim ids() As Variant: ids = Markup.config_.categories_.Keys()
+  For Each catID In ids
+    If g_ActiveCat = catID Then
+      If nIndex <> 0 Then
+        g_ActiveCat = ids(nIndex - 1)
+      Else
+        g_ActiveCat = ids(ArraySize(ids) - 1)
+      End If
+      Exit For
+    End If
+    nIndex = nIndex + 1
+  Next catID
+  Call UIUpdateCategories
+End Function
+
+Public Function UIResetCategories()
+  g_ActiveCat = 0
+  If Markup.config_.IsLoaded Then
+    If Markup.config_.categories_.Count > 0 Then _
+      g_ActiveCat = Markup.config_.categories_.Keys(0)
+  End If
+  Call UIUpdateCategories
+End Function
+
+Public Function UIUpdateCategories()
+  Dim aRibbon As IRibbonUI: Set aRibbon = GetRibbon
+  If Not aRibbon Is Nothing Then _
+    aRibbon.InvalidateControl ("CategoryPicker")
+End Function
+
+Public Function UIUpdateConfigList()
+  Set g_Configs = GetConfigList
+  
+  Dim aRibbon As IRibbonUI: Set aRibbon = GetRibbon
+  If Not aRibbon Is Nothing Then _
+    Call aRibbon.InvalidateControl("ConfigPicker")
+End Function
+
+Public Sub MUC_LoadRibbon(aRibbon As IRibbonUI)
+  Set g_RibbonWrap = New API_Ribbon
+  Call g_RibbonWrap.Init(aRibbon, RibbonTempFile)
+  Call UIUpdateConfigList
+End Sub
+
+Public Sub MUC_OnBtn(iControl As IRibbonControl)
+  Call EnsureGlobalState
+  Select Case iControl.ID
+  Case "OpenConfig":          Call MU_OpenConfig
+  
+  Case "ApplyCategory":       Call MU_ApplyCategory
+  Case "AddCategory":         Call MU_AddCategory
+  Case "RemoveMarkup":        Call MU_ClearFragment
+  
+  Case "NextCategory":        Call MU_NextCategory
+  Case "PrevCategory":        Call MU_PrevCategory
+
+  Case "GetCategory":         Call MU_DetermineCategory
+  Case "NextFragment":        Call MU_GotoNext
+  Case "PreviousFragment":    Call MU_GotoPrev
+  
+  Case "HideCategory":        Call MU_HideText
+  Case "ShowCategory":        Call MU_ShowText
+  
+  Case "HighlightCategory":   Call MU_HighlightText
+  Case "UnhighlightCategory": Call MU_UnhighlightText
+  
+  Case "ExtractVisible":      Call MU_ExtractVisible
+  Case "ExtractCategory":     Call MU_ExtractCategory
+  Case "ExportMarkup":        Call MU_ExportMarkup
+  Case "ImportMarkup":        Call MU_ImportMarkup
+  Case "ExportMarkedText":    Call MU_ExportMarkedText
+  Case "ExportHighlights":    Call MU_ExportHighlights
+  Case "SyncStyles":          Call MU_SyncStyles
+  Case "ViewHelp":            Call MU_ViewHelp
+  End Select
+End Sub
+
+Public Sub MUC_ConfigCount(control As IRibbonControl, ByRef nCount)
+  nCount = g_Configs.Count
+End Sub
+
+Public Sub MUC_ConfigLabel(control As IRibbonControl, nIndex%, ByRef vLabel)
+  vLabel = g_Configs.Item(nIndex + 1).name_
+End Sub
+
+Public Sub MUC_ConfigSelected(control As IRibbonControl, ByRef val)
+  Call EnsureGlobalState
+  val = ActiveConfigIndex - 1
+End Sub
+
+Public Sub MUC_ConfigChange(control As IRibbonControl, sID$, nIndex As Variant)
+  Call EnsureGlobalState
+  If nIndex + 1 = ActiveConfigIndex Or nIndex = -1 Then _
+    Exit Sub
+
+  Dim sName$: sName = ActiveDocument.FullName
+  If MU_LoadConfigFrom(g_Configs.Item(nIndex + 1).path_) Then
+    Call Markup.config_.SyncStyles(ThisDocument.Application, sName)
+  End If
+End Sub
+
+Sub MUC_CatsCount(control As IRibbonControl, ByRef nCount)
+  nCount = Markup.config_.categories_.Count
+End Sub
+
+Public Sub MUC_CatsLabel(control As IRibbonControl, nIndex%, ByRef vLabel)
+  vLabel = Markup.config_.categories_.Items(nIndex).name_
+End Sub
+
+Public Sub MUC_CatsSelected(control As IRibbonControl, ByRef nIndex)
+  Call EnsureGlobalState
+  
+  nIndex = 0
+  Dim catID As Variant
+  For Each catID In Markup.config_.categories_
+    If catID = g_ActiveCat Then _
+      Exit Sub
+    nIndex = nIndex + 1
+  Next catID
+  nIndex = -1
+End Sub
+
+Public Sub MUC_CatsChange(control As IRibbonControl, ID As String, nIndex As Variant)
+  Call EnsureGlobalState
+  If nIndex = -1 Then
+    g_ActiveCat = vbNullString
+  Else
+    g_ActiveCat = Markup.config_.categories_.Keys(nIndex)
+  End If
+End Sub
+
+' =============
+Private Function EnsureGlobalState() As Boolean
+  EnsureGlobalState = Not GetRibbon Is Nothing
+End Function
+
+Private Function ActiveConfigIndex() As Integer
+  If Not Markup.config_.IsLoaded Then _
+    Exit Function
+    
+  Dim nIndex&
+  For nIndex = 1 To g_Configs.Count Step 1
+    If g_Configs.Item(nIndex).path_ = Markup.config_.sourcePath_ Then
+      ActiveConfigIndex = nIndex
+      Exit Function
+    End If
+  Next nIndex
+End Function
+
+Private Function GetRibbon() As IRibbonUI
+  If g_RibbonWrap Is Nothing Then
+    Set g_RibbonWrap = New API_Ribbon
+    Call g_RibbonWrap.LoadFrom(RibbonTempFile)
+    Call UIUpdateConfigList
+  End If
+  Set GetRibbon = g_RibbonWrap.Value
+  If GetRibbon Is Nothing Then _
+    Call UserInteraction.ShowMessage(EM_RIBBON_NOT_REACHABLE)
+End Function

src/test/s_Category.cls

@@ -0,0 +1,203 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "s_Category"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private cat_ As InfoCategory
+
+Public Function Setup()
+  ' Mandatory setup function
+  Set cat_ = New InfoCategory
+End Function
+
+Public Function Teardown()
+  ' Mandatory teardown function
+End Function
+
+Public Function t_InitBasic()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call cat_.InitBasic(1337, "name", "info")
+  Call Dev_ExpectEQ(1337, cat_.id_)
+  Call Dev_ExpectEQ("name", cat_.name_)
+  Call Dev_ExpectEQ("info", cat_.info_)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_Clone()
+  On Error GoTo PROPAGATE_ERROR
+  
+  With cat_
+    .id_ = 1337
+    .name_ = "name1"
+    .info_ = "info1"
+    .style_ = "style1"
+    Set .composition_ = CSet(1, 2, 3)
+  End With
+  
+  Dim iClone As InfoCategory
+  Set iClone = cat_.Clone
+  
+  Call Dev_NewCase("Copy data")
+  Call Dev_ExpectEQ(cat_.id_, iClone.id_)
+  Call Dev_ExpectEQ(cat_.name_, iClone.name_)
+  Call Dev_ExpectEQ(cat_.info_, iClone.info_)
+  Call Dev_ExpectEQ(cat_.style_, iClone.style_)
+  Call Dev_ExpectEQ(cat_.composition_, iClone.composition_)
+  
+  With cat_
+    .id_ = 1338
+    .name_ = "name2"
+    .info_ = "info2"
+    .style_ = "style2"
+    Call .composition_.Add(4, 0)
+  End With
+  
+  Call Dev_NewCase("Deep copy")
+  Call Dev_ExpectNE(cat_.id_, iClone.id_)
+  Call Dev_ExpectNE(cat_.name_, iClone.name_)
+  Call Dev_ExpectNE(cat_.info_, iClone.info_)
+  Call Dev_ExpectNE(cat_.style_, iClone.style_)
+  Call Dev_ExpectNE(cat_.composition_, iClone.composition_)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_IsCombo()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_ExpectFalse(cat_.IsCombo, "Empty category")
+  
+  Call cat_.composition_.Add(1, 0)
+  Call Dev_ExpectFalse(cat_.IsCombo, "Single parent")
+  
+  Call cat_.composition_.Add(2, 0)
+  Call Dev_ExpectTrue(cat_.IsCombo, "Valid combo")
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_IsComplete()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_ExpectFalse(cat_.IsComplete, "Empty category")
+  
+  Call Dev_NewCase("Completely defined basic")
+  With cat_
+    .id_ = 1337
+    .name_ = "name1"
+    .info_ = "info1"
+    .style_ = "style1"
+  End With
+  Call Dev_ExpectTrue(cat_.IsComplete)
+  
+  Call Dev_NewCase("Completely defined combo")
+  Set cat_.composition_ = CSet(1, 2, 3)
+  Call Dev_ExpectTrue(cat_.IsComplete)
+  
+  Call Dev_NewCase("Missing style")
+  cat_.style_ = ""
+  Call Dev_ExpectFalse(cat_.IsComplete)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_ImportComposition()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_ExpectTrue(cat_.ImportComposition(""), "Empty input")
+  Call Dev_ExpectFalse(cat_.ImportComposition("invalid"), "Invalid id")
+  
+  Call Dev_NewCase("Single parent")
+  Call Dev_ExpectTrue(cat_.ImportComposition("1"))
+  Call Dev_ExpectEQ(1, cat_.composition_.Keys(0))
+  
+  Call Dev_NewCase("Valid input")
+  Call Dev_ExpectTrue(cat_.ImportComposition("2; 3; 4"))
+  Call Dev_ExpectEQ(CSet(2, 3, 4), cat_.composition_)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_GetCompositionString()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_ExpectEQ("", cat_.GetCompositionString, "Empty composition")
+  
+  Call Dev_NewCase("Single parent")
+  Set cat_.composition_ = CSet(1)
+  Call Dev_ExpectEQ("1", cat_.GetCompositionString)
+
+  Call Dev_NewCase("Valid input")
+  Set cat_.composition_ = CSet(1, 2, 3)
+  Call Dev_ExpectEQ("1; 2; 3", cat_.GetCompositionString)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_GetFormat()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Dim iBase As Word.Style: Set iBase = ThisDocument.Styles(wdStyleNormal)
+  Dim iHeader As Word.Style: Set iHeader = ThisDocument.Styles(wdStyleHeading1)
+  
+  Call Dev_NewCase("Diff with base")
+  Dim iEmpty As New InfoFormat
+  cat_.style_ = iBase.NameLocal
+  Dim iResult As InfoFormat: Set iResult = cat_.GetFormat(ThisDocument)
+  Call Dev_ExpectTrue(iResult.Compare(iEmpty) = 0)
+  
+  Call Dev_NewCase("Diff with header")
+  Dim iDiff As New InfoFormat: Call iDiff.InitFromWordDiff(iBase, iHeader)
+  cat_.style_ = iHeader.NameLocal
+  Set iResult = cat_.GetFormat(ThisDocument)
+  Call Dev_ExpectTrue(iResult.Compare(iDiff) = 0)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_IsIncludedIn()
+  On Error GoTo PROPAGATE_ERROR
+  
+  cat_.id_ = 1
+  Call Dev_ExpectFalse(cat_.IsIncludedIn(cat_), "Self not included")
+  
+  Call Dev_NewCase("Basic included")
+  Dim iParent As New InfoCategory
+  iParent.id_ = 42
+  Call Dev_ExpectFalse(iParent.IsIncludedIn(cat_), "No connection")
+  Set iParent.composition_ = CSet(1)
+  Call Dev_ExpectFalse(iParent.IsIncludedIn(cat_))
+  Call Dev_ExpectTrue(cat_.IsIncludedIn(iParent))
+  
+  Call Dev_NewCase("Complex included")
+  Set cat_.composition_ = CSet(2, 3)
+  Set iParent.composition_ = CSet(2, 3, 4)
+  Call Dev_ExpectFalse(iParent.IsIncludedIn(cat_))
+  Call Dev_ExpectTrue(cat_.IsIncludedIn(iParent))
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function

src/test/s_Config.cls

@@ -0,0 +1,355 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "s_Config"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private fso_ As Scripting.FileSystemObject
+Private config_ As InfoConfig
+Private wordApp_ As API_WordWrapper
+
+' TODO:
+' Public Function SyncDocument(target As Word.Document)
+' Public Function SaveAs(outPath$) As Boolean
+' Public Function Save() As Boolean
+' Public Function CreateStyle(targetID&, sStyleName$, iDoc As Word.Document) As Boolean
+
+Public Function Setup()
+  ' Mandatory setup function
+  Set config_ = New InfoConfig
+  Set fso_ = New Scripting.FileSystemObject
+  Set wordApp_ = New API_WordWrapper
+  Call wordApp_.SetApplication(ThisDocument.Application)
+  
+  Call ResetTestFolder
+End Function
+
+Public Function Teardown()
+  ' Mandatory teardown function
+  Call fso_.DeleteFolder(GetTestFolder)
+End Function
+
+Public Function t_Load()
+  On Error GoTo PROPAGATE_ERROR
+
+  Call Dev_NewCase("Valid load")
+  Call config_.Load(SetupTestConfig)
+  Call Dev_ExpectTrue(config_.IsLoaded)
+  Call Dev_ExpectEQ(3, config_.categories_.Count)
+  
+  Call Dev_NewCase("Missing file")
+  Dim iConfig As New InfoConfig
+  Call Dev_ExpectFalse(iConfig.IsLoaded)
+  Call Dev_ExpectFalse(iConfig.Load("invalid file"))
+  Call Dev_ExpectFalse(iConfig.IsLoaded)
+  Call Dev_ExpectEQ(0, iConfig.categories_.Count)
+  
+  Call Dev_NewCase("Invalid file")
+  Dim sFile$: sFile = GetTestFolder & "\" & "test1.docx"
+  Dim iWord As New API_WordWrapper: Call iWord.NewDocument
+  Call iWord.SaveAs(sFile)
+  Call iWord.ReleaseDocument
+  Call Dev_ExpectFalse(iConfig.Load(sFile))
+  Call Dev_ExpectFalse(iConfig.IsLoaded)
+  Call Dev_ExpectEQ(0, iConfig.categories_.Count)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_BasicCategory()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Dim iCat As InfoCategory
+  Call Dev_ExpectNothing(config_.AddBasicCategory("", ""), "Empty name")
+  Call Dev_ExpectNothing(config_.GetAt(1))
+  
+  Call Dev_NewCase("Empty info")
+  Set iCat = config_.AddBasicCategory("test1", "")
+  Call Dev_AssertNotNothing(iCat)
+  Call Dev_ExpectEQ(1, iCat.id_)
+  Call Dev_ExpectEQ("test1", iCat.name_)
+  Call Dev_ExpectEQ("", iCat.info_)
+  Call Dev_ExpectEQ(iCat, config_.GetAt(1))
+  Call Dev_ExpectEQ(0, config_.CountCombos)
+  Call Dev_ExpectEQ(1, config_.CountIncomplete)
+  iCat.style_ = "TStyle"
+  Call Dev_ExpectEQ(0, config_.CountIncomplete)
+  
+  Call Dev_NewCase("Valid basic")
+  Set iCat = config_.AddBasicCategory("test2", "info")
+  Call Dev_AssertNotNothing(iCat)
+  Call Dev_ExpectEQ(2, iCat.id_)
+  Call Dev_ExpectEQ("test2", iCat.name_)
+  Call Dev_ExpectEQ("info", iCat.info_)
+  Call Dev_ExpectEQ(0, config_.CountCombos)
+  Call Dev_ExpectEQ(1, config_.CountIncomplete)
+  
+  Call Dev_NewCase("Duplicate")
+  On Error Resume Next
+  Call Dev_ExpectNothing(config_.AddBasicCategory("test1", "123"))
+  Call Dev_ExpectError(ERR_CAT_NAME_TAKEN)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_ComboCategory()
+  On Error GoTo PROPAGATE_ERROR
+
+  Dim iCombo As InfoCategory
+  Call Dev_ExpectNothing(config_.AddCombinedCategory("", CSet()), "Empty name")
+  
+  Call Dev_NewCase("Name taken")
+  Dim iBase1 As InfoCategory: Set iBase1 = config_.AddBasicCategory("base1", "info1")
+  Dim iBase2 As InfoCategory: Set iBase2 = config_.AddBasicCategory("base2", "info2")
+  Dim iComp As Scripting.Dictionary: Set iComp = CSet(iBase1.id_, iBase2.id_)
+  On Error Resume Next
+  Call Dev_ExpectNothing(config_.AddCombinedCategory("base1", iComp))
+  Call Dev_ExpectError(ERR_CAT_NAME_TAKEN)
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Invalid combo cat")
+  On Error Resume Next
+  Call Dev_ExpectNothing(config_.AddCombinedCategory("derived", CSet(iBase1.id_ + iBase2.id_, iBase1.id_), "info3"))
+  Call Dev_ExpectError(EM_UNKNOWN_CAT_ID)
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Valid combo add")
+  Set iCombo = config_.AddCombinedCategory("derived", iComp, "info3")
+  Call Dev_AssertNotNothing(iCombo)
+  Call Dev_ExpectEQ(3, config_.categories_.Count, "Cats count")
+  Call Dev_ExpectEQ(1, config_.CountCombos)
+  Call Dev_ExpectEQ(3, config_.CountIncomplete)
+  Call Dev_ExpectEQ(3, iCombo.id_)
+  Call Dev_ExpectEQ("derived", iCombo.name_)
+  Call Dev_ExpectEQ("info3", iCombo.info_)
+  Call Dev_ExpectEQ(iComp, iCombo.composition_)
+  
+  Call Dev_NewCase("Combo taken")
+  On Error Resume Next
+  Call Dev_ExpectNothing(config_.AddCombinedCategory("derived", iComp, "info3"))
+  Call Dev_ExpectError(ERR_COMBO_TAKEN)
+  On Error GoTo PROPAGATE_ERROR
+
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_EraseCategory()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Empty config")
+  Call Dev_ExpectFalse(config_.EraseCategory(1337))
+  
+  Call Dev_NewCase("Missing id")
+  Dim iCat As InfoCategory: Set iCat = config_.AddBasicCategory("test", "info")
+  Call Dev_ExpectFalse(config_.EraseCategory(iCat.id_ + 1))
+  Call Dev_ExpectEQ(1, config_.categories_.Count)
+  
+  Call Dev_NewCase("Valid erase basic")
+  Call Dev_ExpectTrue(config_.EraseCategory(iCat.id_))
+  Call Dev_ExpectEQ(0, config_.categories_.Count)
+  
+  Call Dev_NewCase("Delete with dependencies")
+  Dim iParent1 As InfoCategory: Set iParent1 = config_.AddBasicCategory("test1", "info")
+  Dim iParent2 As InfoCategory: Set iParent2 = config_.AddBasicCategory("test2", "info")
+  Dim iChild As InfoCategory: Set iChild = config_.AddCombinedCategory("test3", CSet(iParent1.id_), "info")
+  Call Dev_ExpectTrue(config_.EraseCategory(iParent1.id_))
+  Call Dev_ExpectEQ(1, config_.categories_.Count)
+  Call Dev_ExpectTrue(config_.Contains(iParent2.id_))
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_Access()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Empty config")
+  Call Dev_ExpectFalse(config_.Contains(1337), "Contains")
+  Call Dev_ExpectNothing(config_.GetAt(1337), "GetAt")
+  Call Dev_ExpectNothing(config_.FindName("test"), "FindName")
+  Call Dev_ExpectNothing(config_.FindStyle("style"), "FindStyle")
+  Call Dev_ExpectNothing(config_.FindComposition(CSet(1, 2)), "FindComposition")
+  
+  Call Dev_NewCase("Valid access")
+  Dim iBase1 As InfoCategory: Set iBase1 = config_.AddBasicCategory("base1", "info1")
+  Dim iBase2 As InfoCategory: Set iBase2 = config_.AddBasicCategory("base2", "info2")
+  iBase1.style_ = "style"
+  Dim iComp As Scripting.Dictionary: Set iComp = CSet(iBase1.id_, iBase2.id_)
+  Dim iChild As InfoCategory: Set iChild = config_.AddCombinedCategory("derived", iComp, "info3")
+  Call Dev_ExpectTrue(config_.Contains(iBase1.id_), "Contains")
+  Call Dev_ExpectEQ(iBase2, config_.GetAt(iBase2.id_), "GetAt")
+  Call Dev_ExpectEQ(iChild, config_.FindName("derived"), "FindName")
+  Call Dev_ExpectEQ(iBase1, config_.FindStyle("style"), "FindStyle")
+  Call Dev_ExpectEQ(iChild, config_.FindComposition(iComp), "FindComposition")
+  
+  Call Dev_NewCase("Invalid access")
+  Call Dev_ExpectFalse(config_.Contains(1337), "Contains")
+  Call Dev_ExpectNothing(config_.GetAt(1337), "GetAt")
+  Call Dev_ExpectNothing(config_.FindName("test123"), "FindName")
+  Call Dev_ExpectNothing(config_.FindStyle("style123"), "FindStyle")
+  Call Dev_ExpectNothing(config_.FindComposition(CSet(1, 2, 3, 4)), "FindComposition")
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_ReduceComposition()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Empty config")
+  Call Dev_ExpectEQ(CSet(), config_.ReduceComposition(CSet))
+  
+  Call config_.AddBasicCategory("base1") ' 1
+  Call config_.AddBasicCategory("base2") ' 2
+  Call config_.AddBasicCategory("base3") ' 3
+  Call config_.AddCombinedCategory("derived1", CSet(1, 2)) ' 4
+  Call config_.AddCombinedCategory("derived2", CSet(3, 4)) ' 5
+  
+  Call Dev_NewCase("Invalid id")
+  Call Dev_ExpectNothing(config_.ReduceComposition(CSet(1, 1337)))
+  
+  Call Dev_NewCase("Valid reductions")
+  Call Dev_ExpectEQ(CSet(1), config_.ReduceComposition(CSet(1)))
+  Call Dev_ExpectEQ(CSet(1, 2), config_.ReduceComposition(CSet(4)))
+  Call Dev_ExpectEQ(CSet(1, 2, 3), config_.ReduceComposition(CSet(5)))
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_GetChildrenOf()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Empty config")
+  Call Dev_ExpectNothing(config_.GetChildrenOf(1337))
+  
+  Call config_.AddBasicCategory("base1") ' 1
+  Call config_.AddBasicCategory("base2") ' 2
+  Call config_.AddBasicCategory("base3") ' 3
+  Call config_.AddCombinedCategory("derived1", CSet(1, 2)) ' 4
+  Call config_.AddCombinedCategory("derived2", CSet(3, 4)) ' 5
+  
+  Call Dev_NewCase("Valid ids")
+  Call Dev_ExpectEQ(CSet(), config_.GetChildrenOf(5), "Parent category")
+  Call Dev_ExpectEQ(CSet(5), config_.GetChildrenOf(4))
+  Call Dev_ExpectEQ(CSet(4, 5), config_.GetChildrenOf(1))
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_SyncStyles()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call config_.Load(SetupTestConfig)
+  Dim iDoc As Word.Document: Set iDoc = wordApp_.NewDocument()
+  
+  Call Dev_NewCase("Empty config")
+  Dim iConfig As New InfoConfig
+  On Error Resume Next
+  Call iConfig.SyncStyles(wordApp_.Application, iDoc.Path)
+  Call iConfig.SyncStyles(wordApp_.Application, iDoc.Path)
+  Call Dev_ExpectNoError
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Valid transfer")
+  Call config_.AddBasicCategory("TestIncomplete")
+  On Error Resume Next
+  Call config_.SyncStyles(wordApp_.Application, iDoc.Path)
+  Call Dev_ExpectNoError
+  On Error GoTo PROPAGATE_ERROR
+  Call config_.SyncStyles(wordApp_.Application, iDoc.FullName)
+  Call Dev_ExpectTrue(WordStyleExists(iDoc, config_.categories_(1).style_))
+
+  Call wordApp_.ReleaseDocument(bCloseApplication:=False, bSaveChanges:=False)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_FindFormat()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call config_.Load(SetupTestConfig)
+  Dim iDoc As Word.Document: Set iDoc = wordApp_.NewDocument(config_.sourcePath_)
+  Dim iFormat As New InfoFormat
+  
+  Call Dev_NewCase("Empty format")
+  Call Dev_ExpectNothing(config_.FindFormat(iFormat, iDoc))
+  
+  Call Dev_NewCase("Valid find")
+  Call config_.AddBasicCategory("TestIncomplete")
+  Dim iCat As InfoCategory: Set iCat = config_.categories_(1)
+  Call Dev_ExpectEQ(iCat, config_.FindFormat(iCat.GetFormat(iDoc), iDoc))
+  
+  Call wordApp_.ReleaseDocument(bCloseApplication:=False, bSaveChanges:=False)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_AssignStyle()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Dim iDoc As Word.Document: Set iDoc = wordApp_.NewDocument()
+  
+  Call Dev_NewCase("Empty config")
+  Call Dev_ExpectFalse(config_.AssignStyle(1, iDoc.Styles(wdStyleNormal), iDoc))
+  
+  Call Dev_NewCase("Valid config - errors")
+  Call config_.Load(SetupTestConfig)
+  Call config_.SyncStyles(iDoc.Application, iDoc.FullName)
+  Dim iStyle1 As Word.Style: Set iStyle1 = iDoc.Styles("Style1")
+  
+  Call Dev_ExpectFalse(config_.AssignStyle(1337, iStyle1, iDoc), "Invalid id")
+  Call Dev_ExpectFalse(config_.AssignStyle(1, iStyle1, iDoc), "Style already assigned")
+  
+  On Error Resume Next
+  Call Dev_ExpectFalse(config_.AssignStyle(2, iStyle1, iDoc), "Style is taken")
+  Call Dev_ExpectError(ERR_STYLE_TAKEN, "Style is taken")
+  On Error GoTo PROPAGATE_ERROR
+  
+  On Error Resume Next
+  Call Dev_ExpectFalse(config_.AssignStyle(1, iDoc.Styles(wdStyleNormal), iDoc), "Invalid style")
+  Call Dev_ExpectError(ERR_STYLE_NO_FORMAT, "Invalid style")
+  On Error GoTo PROPAGATE_ERROR
+  
+  Dim iStyleNew As Word.Style: Set iStyleNew = iDoc.Styles.Add("StyleNew", wdStyleTypeCharacter)
+  iStyleNew.Font.Italic = True
+  iStyleNew.Font.Bold = True
+  On Error Resume Next
+  Call Dev_ExpectFalse(config_.AssignStyle(1, iStyleNew, iDoc), "Format taken")
+  Call Dev_ExpectError(ERR_FORMAT_TAKEN, "Format taken")
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Valid config - assign style")
+  iStyleNew.Font.Underline = wdUnderlineDouble
+  Call Dev_ExpectTrue(config_.AssignStyle(1, iStyleNew, iDoc))
+  Call Dev_ExpectTrue(config_.AssignStyle(2, iStyle1, iDoc), "Reassign old style")
+  
+  Call wordApp_.ReleaseDocument(bCloseApplication:=False, bSaveChanges:=False)
+  Set iDoc = wordApp_.OpenDocument(config_.sourcePath_)
+  Call Dev_ExpectTrue(WordStyleExists(iDoc, "StyleNew"), "Add style to config")
+  Call wordApp_.ReleaseDocument(bCloseApplication:=False, bSaveChanges:=False)
+
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function

src/test/s_DBMarkup.cls

@@ -0,0 +1,33 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "s_DBMarkup"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+' TODO:
+' Public Function RemoveAll()
+' Public Function ImportFromExcel(iSource As Excel.Worksheet) As Boolean
+' Public Function ImportFromWord(iSource As InfoDocument) As Boolean
+' Public Function RemoveSource(sourcePath$) As Long
+
+Public Function Setup()
+  ' Mandatory setup function
+End Function
+
+Public Function Teardown()
+  ' Mandatory teardown function
+  Call AccessData.RemoveAll
+End Function
+
+Public Function t_Init()
+  On Error GoTo PROPAGATE_ERROR
+
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function

src/test/s_Format.cls

@@ -0,0 +1,155 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "s_Format"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private format_ As InfoFormat
+
+Public Function Setup()
+  ' Mandatory setup function
+  Set format_ = New InfoFormat
+End Function
+
+Public Function Teardown()
+  ' Mandatory teardown function
+End Function
+
+Public Function t_IsEmpty()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_ExpectTrue(format_.IsEmpty, "Empty")
+  
+  Call format_.features_.Add(T_FF_FONT_NAME, "test")
+  Call Dev_ExpectFalse(format_.IsEmpty, "Not empty")
+
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_InitFromWord()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Dim iStyle As Word.Style: Set iStyle = ThisDocument.Styles(wdStyleNormal)
+  Call format_.InitFromWord(iStyle)
+  Call Dev_ExpectFalse(format_.IsEmpty)
+  Call Dev_AssertEQ(TFormatFeature.[_Last] - TFormatFeature.[_First] + 1, format_.features_.Count)
+  Call Dev_ExpectEQ(iStyle.Font.Name, format_.features_(T_FF_FONT_NAME), "Font name")
+  
+  Call Dev_ExpectEQ(iStyle.Font.Size, format_.features_(T_FF_FONT_SIZE), "Font size")
+  Call Dev_ExpectEQ(iStyle.Font.Bold, format_.features_(T_FF_BOLD), "Bold")
+  Call Dev_ExpectEQ(iStyle.Font.Italic, format_.features_(T_FF_ITALIC), "Italic")
+  Call Dev_ExpectEQ(iStyle.Font.TextColor, format_.features_(T_FF_TEXT_COLOR), "Text color")
+  Call Dev_ExpectEQ(iStyle.Font.Shading.BackgroundPatternColor, format_.features_(T_FF_BG_COLOR), "Background color")
+  Call Dev_ExpectEQ(iStyle.Font.UnderlineColor, format_.features_(T_FF_UNDERLINE_COLOR), "Underline color")
+  Call Dev_ExpectEQ(iStyle.Font.StrikeThrough, format_.features_(T_FF_STRIKETHROUGH), "Strikethrough")
+  Call Dev_ExpectEQ(iStyle.Font.Underline, format_.features_(T_FF_UNDERLINE), "Underline")
+  Call Dev_ExpectEQ(iStyle.Font.AllCaps, format_.features_(T_FF_ALLCAPS), "All caps")
+
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_InitFromWordDiff()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Dim iBase As Word.Style: Set iBase = ThisDocument.Styles(wdStyleNormal)
+  Dim iHeader As Word.Style: Set iHeader = ThisDocument.Styles(wdStyleHeading1)
+
+  Call Dev_NewCase("Self diff")
+  Call format_.InitFromWordDiff(iBase, iBase)
+  Call Dev_ExpectTrue(format_.IsEmpty)
+  Call format_.InitFromWordDiff(iHeader, iHeader)
+  Call Dev_ExpectTrue(format_.IsEmpty)
+  
+  Call Dev_NewCase("Valid diff")
+  Call format_.InitFromWordDiff(iBase, iHeader)
+  Call Dev_ExpectEQ(3, format_.features_.Count)
+  
+  Call Dev_ExpectEQ(iHeader.Font.Size, format_.features_(T_FF_FONT_SIZE), "Font size")
+  Call Dev_ExpectEQ(iHeader.Font.Bold, format_.features_(T_FF_BOLD), "Bold")
+  Call Dev_ExpectEQ(iHeader.Font.AllCaps, format_.features_(T_FF_ALLCAPS), "All caps")
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_ApplyToWordFont()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Dim iBase As Word.Style: Set iBase = ThisDocument.Styles(wdStyleNormal)
+  Dim iHeader As Word.Style: Set iHeader = ThisDocument.Styles(wdStyleHeading1)
+  Call format_.InitFromWordDiff(iBase, iHeader)
+  
+  Call Dev_NewCase("Apply to style font")
+  Dim iTarget As Word.Style: Set iTarget = ThisDocument.Styles.Add("TestStyle", wdStyleTypeCharacter)
+  iTarget.Font.Italic = True
+  
+  Call format_.ApplyToWordFont(iTarget.Font)
+  Call Dev_ExpectEQ(format_.features_(T_FF_FONT_SIZE), iTarget.Font.Size, "Font size")
+  Call Dev_ExpectEQ(format_.features_(T_FF_BOLD), iTarget.Font.Bold, "Bold")
+  Call Dev_ExpectEQ(format_.features_(T_FF_ALLCAPS), iTarget.Font.AllCaps, "All caps")
+  Call Dev_ExpectEQ(True, iTarget.Font.Italic, "Keep undef features")
+  
+  Call iTarget.Delete
+  
+  Call Dev_NewCase("Apply to range font")
+  Dim rTarget As Word.Range: Set rTarget = ThisDocument.Range
+  Call rTarget.InsertAfter("after")
+  rTarget.Font.Italic = True
+  
+  Call format_.ApplyToWordFont(rTarget.Font)
+  Call Dev_ExpectEQ(format_.features_(T_FF_FONT_SIZE), rTarget.Font.Size, "Font size")
+  Call Dev_ExpectEQ(format_.features_(T_FF_BOLD), rTarget.Font.Bold, "Bold")
+  Call Dev_ExpectEQ(format_.features_(T_FF_ALLCAPS), rTarget.Font.AllCaps, "All caps")
+  Call Dev_ExpectEQ(True, rTarget.Font.Italic, "Keep undef features")
+  
+  Call rTarget.Delete
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_Merge()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Dim f1 As New InfoFormat
+  Dim f2 As New InfoFormat
+  Call Dev_ExpectTrue(f1.IsCompatibleWith(f2), "Empty to empty")
+  On Error Resume Next
+  Call f1.MergeWith(f2)
+  Call Dev_ExpectNoError
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call f1.features_.Add(T_FF_FONT_SIZE, 42)
+  Call Dev_ExpectTrue(f2.IsCompatibleWith(f1), "Empty to non-empty")
+  Call Dev_ExpectTrue(f1.IsCompatibleWith(f2), "Non-empty to empty")
+  
+  Call Dev_NewCase("Complement features")
+  Call f2.features_.Add(T_FF_BOLD, True)
+  Call Dev_ExpectTrue(f2.IsCompatibleWith(f1))
+  Call Dev_ExpectTrue(f1.IsCompatibleWith(f2))
+  Call f1.MergeWith(f2)
+  Call Dev_AssertEQ(2, f1.features_.Count)
+  Call Dev_ExpectEQ(42, f1.features_(T_FF_FONT_SIZE), "Font size")
+  Call Dev_ExpectEQ(True, f1.features_(T_FF_BOLD), "Bold")
+  
+  Call Dev_NewCase("Incompatible values")
+  f2.features_.Item(T_FF_BOLD) = False
+  Call Dev_ExpectFalse(f1.IsCompatibleWith(f2))
+  Call Dev_ExpectFalse(f2.IsCompatibleWith(f1))
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+

src/test/s_MarkupAPI.cls

@@ -0,0 +1,43 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "s_MarkupAPI"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+' TODO:
+' Public Function InitFromCurrentDocument(target As Word.Document) As Boolean
+' Public Function SyncWord(target As Word.Document) As Boolean
+
+' Public Function ValidateConfig(styleDoc As Word.Document) As String
+
+Private fso_ As Scripting.FileSystemObject
+Private markup_ As MarkupAPI
+
+Public Function Setup()
+  ' Mandatory setup function
+  Set markup_ = New MarkupAPI
+  Set fso_ = New Scripting.FileSystemObject
+  Call ResetTestFolder
+  Call markup_.LoadConfig(SetupTestConfig)
+End Function
+
+Public Function Teardown()
+  ' Mandatory teardown function
+  Call fso_.DeleteFolder(GetTestFolder)
+End Function
+
+Public Function t_LoadConfig()
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_ExpectTrue(markup_.config_.IsLoaded)
+  Call Dev_ExpectEQ(3, markup_.config_.categories_.Count)
+
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function

src/test/s_WordDocument.cls

@@ -0,0 +1,341 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "s_WordDocument"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+' TODO:
+' Public Function GetAllHighlights() As Collection ' of ItemFragment
+' Public Function GetBasicFragmentsCompound() As Collection ' of ItemFragment
+' Public Function GetAllFragments() As Collection ' of ItemFragment
+
+Private fso_ As Scripting.FileSystemObject
+Private markup_ As MarkupAPI
+Private word_ As API_WordWrapper
+Private doc_ As InfoDocument
+
+Public Function Setup()
+  ' Mandatory setup function
+  Set fso_ = New Scripting.FileSystemObject
+  Call ResetTestFolder
+  Set markup_ = New MarkupAPI
+  Call markup_.LoadConfig(SetupTestConfig)
+  Set word_ = New API_WordWrapper
+  Call word_.SetApplication(ThisDocument.Application)
+  Set doc_ = New InfoDocument
+  Call doc_.Init(word_.NewDocument, markup_)
+  Call doc_.SyncStyles
+End Function
+
+Public Function Teardown()
+  ' Mandatory teardown function
+  Call fso_.DeleteFolder(GetTestFolder)
+  Call word_.ReleaseDocument
+End Function
+
+Public Function t_ApplyCategory()
+  On Error GoTo PROPAGATE_ERROR
+  ' =================12345678901234567
+  doc_.doc_.Range = "Test1 test2 test3"
+  
+  Call Dev_NewCase("Valid category")
+  Dim iTarget As Word.Range: Set iTarget = doc_.doc_.Range(7, 10)
+  Dim iCat As InfoCategory: Set iCat = markup_.config_.categories_(1)
+  Call Dev_ExpectTrue(doc_.ApplyCategory(iCat, iTarget))
+  Call Dev_ExpectEQ(iCat.style_, iTarget.Style)
+  Call Dev_ExpectNE(iCat.style_, doc_.doc_.Range(6, 7).Style)
+  Call Dev_ExpectNE(iCat.style_, doc_.doc_.Range(10, 11).Style)
+  
+  Call Dev_NewCase("Incomplete category")
+  Dim iNewCat As InfoCategory: Set iNewCat = markup_.config_.AddBasicCategory("Test1233")
+  Call Dev_ExpectFalse(doc_.ApplyCategory(iNewCat, iTarget))
+  Call Dev_ExpectEQ(iCat.style_, iTarget.Style)
+  
+  Call Dev_NewCase("Override category")
+  Set iCat = markup_.config_.categories_(2)
+  Call Dev_ExpectTrue(doc_.ApplyCategory(iCat, iTarget))
+  Call Dev_ExpectEQ(iCat.style_, iTarget.Style)
+
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_ApplyFragments()
+  On Error GoTo PROPAGATE_ERROR
+  ' =================12345678901234567
+  doc_.doc_.Range = "Test1 test2 test3"
+  
+  Dim iTarget1 As Word.Range: Set iTarget1 = doc_.doc_.Range(7, 10)
+  Dim iTarget2 As Word.Range: Set iTarget2 = doc_.doc_.Range(13, 17)
+  Dim iCat1 As InfoCategory: Set iCat1 = markup_.config_.categories_(1)
+  Dim iCat2 As InfoCategory: Set iCat2 = markup_.config_.categories_(2)
+  
+  Call Dev_NewCase("Empty input")
+  Dim iFragments As New Collection
+  On Error Resume Next
+  Call Dev_ExpectTrue(doc_.ApplyFragments(iFragments))
+  Call Dev_ExpectNoError
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Valid input")
+  Dim iFrag As New ItemFragment
+  Call iFrag.Init(iCat1.id_, iTarget1.Start, iTarget1.End)
+  Call iFragments.Add(iFrag.Clone)
+  Call iFrag.Init(iCat2.id_, iTarget2.Start, iTarget2.End)
+  Call iFragments.Add(iFrag.Clone)
+  Call Dev_ExpectTrue(doc_.ApplyFragments(iFragments))
+  Call Dev_ExpectEQ(iCat1.style_, iTarget1.Style)
+  Call Dev_ExpectEQ(iCat2.style_, iTarget2.Style)
+  
+  Call Dev_NewCase("Invalid category")
+  iFragments.Item(1).id_ = 1337
+  Call Dev_ExpectFalse(doc_.ApplyFragments(iFragments))
+
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_AddCategory()
+  On Error GoTo PROPAGATE_ERROR
+  ' =================12345678901234567
+  doc_.doc_.Range = "Test1 test2 test3"
+  
+  Call Dev_NewCase("Add to empty")
+  Dim iTarget As Word.Range: Set iTarget = doc_.doc_.Range(7, 10)
+  Dim iCat1 As InfoCategory: Set iCat1 = markup_.config_.categories_(1)
+  Call Dev_ExpectTrue(doc_.AddCategory(iCat1, iTarget))
+  Call Dev_ExpectEQ(iCat1.style_, iTarget.Style)
+  Call Dev_ExpectNE(iCat1.style_, doc_.doc_.Range(6, 7).Style)
+  Call Dev_ExpectNE(iCat1.style_, doc_.doc_.Range(10, 11).Style)
+  
+  Call Dev_NewCase("Incomplete category")
+  Dim iNewCat As InfoCategory: Set iNewCat = markup_.config_.AddBasicCategory("Test1233")
+  Call Dev_ExpectFalse(doc_.ApplyCategory(iNewCat, iTarget))
+  Call Dev_ExpectEQ(iCat1.style_, iTarget.Style)
+  
+  Call Dev_NewCase("Add to same")
+  Call Dev_ExpectTrue(doc_.AddCategory(iCat1, iTarget))
+  Call Dev_ExpectEQ(iCat1.style_, iTarget.Style)
+  
+  Call Dev_NewCase("Add with new merge")
+  Dim iCat2 As InfoCategory: Set iCat2 = markup_.config_.categories_(2)
+  Dim nCount&: nCount = markup_.config_.categories_.Count
+  Call Dev_ExpectFalse(doc_.AddCategory(iCat2, iTarget))
+
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_SetCategoryVisible()
+  On Error GoTo PROPAGATE_ERROR
+  ' =================12345678901234567
+  doc_.doc_.Range = "Test1 test2 test3"
+  Dim iTarget As Word.Range: Set iTarget = doc_.doc_.Range(7, 10)
+  Dim iCat As InfoCategory: Set iCat = markup_.config_.categories_(1)
+  
+  Call Dev_NewCase("No formatting")
+  On Error Resume Next
+  Call doc_.SetCategoryVisible(1337, bShow:=False)
+  Call Dev_ExpectNoError("Invalid ID")
+  On Error Resume Next
+  Call doc_.SetCategoryVisible(1, bShow:=False)
+  Call Dev_ExpectNoError("No formatting")
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Valid visibility")
+  Call Dev_AssertTrue(doc_.ApplyCategory(iCat, iTarget))
+  Call doc_.SetCategoryVisible(iCat.id_, bShow:=True)
+  Call Dev_ExpectFalse(iTarget.Font.Hidden, "Show visible")
+  Call doc_.SetCategoryVisible(iCat.id_, bShow:=False)
+  Call Dev_ExpectTrue(iTarget.Font.Hidden, "Hide visible")
+  Call doc_.SetCategoryVisible(iCat.id_, bShow:=False)
+  Call Dev_ExpectTrue(iTarget.Font.Hidden, "Hide hiden")
+  Call doc_.SetCategoryVisible(iCat.id_, bShow:=True)
+  Call Dev_ExpectFalse(iTarget.Font.Hidden, "Show visible")
+  
+  Call Dev_NewCase("Multiple targets")
+  Dim iTarget2 As Word.Range: Set iTarget2 = doc_.doc_.Range(1, 5)
+  Call Dev_AssertTrue(doc_.ApplyCategory(iCat, iTarget2))
+  Call doc_.SetCategoryVisible(iCat.id_, bShow:=False)
+  Call Dev_ExpectTrue(iTarget.Font.Hidden)
+  Call Dev_ExpectTrue(iTarget2.Font.Hidden)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_SetCategoryHighlight()
+  On Error GoTo PROPAGATE_ERROR
+  ' =================12345678901234567
+  doc_.doc_.Range = "Test1 test2 test3"
+  Dim iTarget As Word.Range: Set iTarget = doc_.doc_.Range(7, 10)
+  Dim iCat As InfoCategory: Set iCat = markup_.config_.categories_(1)
+  
+  Call Dev_NewCase("No formatting")
+  On Error Resume Next
+  Call doc_.SetCategoryHighlight(1337, bHighlight:=False)
+  Call Dev_ExpectNoError("Invalid ID")
+  On Error Resume Next
+  Call doc_.SetCategoryHighlight(1, bHighlight:=False)
+  Call Dev_ExpectNoError("No formatting")
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Valid visibility")
+  Call Dev_AssertTrue(doc_.ApplyCategory(iCat, iTarget))
+  Call doc_.SetCategoryHighlight(iCat.id_, bHighlight:=False)
+  Call Dev_ExpectEQ(wdNoHighlight, iTarget.HighlightColorIndex, "Unhighlight plain")
+  Call doc_.SetCategoryHighlight(iCat.id_, bHighlight:=True)
+  Call Dev_ExpectEQ(wdYellow, iTarget.HighlightColorIndex, "Highlight plain")
+  Call doc_.SetCategoryHighlight(iCat.id_, bHighlight:=True)
+  Call Dev_ExpectEQ(wdYellow, iTarget.HighlightColorIndex, "Highlight highlighted")
+  Call doc_.SetCategoryHighlight(iCat.id_, bHighlight:=False)
+  Call Dev_ExpectEQ(wdNoHighlight, iTarget.HighlightColorIndex, "Unhighlight highlighted")
+  
+  Call Dev_NewCase("Multiple targets")
+  Dim iTarget2 As Word.Range: Set iTarget2 = doc_.doc_.Range(1, 5)
+  Call Dev_AssertTrue(doc_.ApplyCategory(iCat, iTarget2))
+  Call doc_.SetCategoryHighlight(iCat.id_, bHighlight:=True)
+  Call Dev_ExpectEQ(wdYellow, iTarget.HighlightColorIndex)
+  Call Dev_ExpectEQ(wdYellow, iTarget.HighlightColorIndex)
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_IteratorFormat()
+  On Error GoTo PROPAGATE_ERROR
+  ' =================12345678901234567
+  doc_.doc_.Range = "Test1 test2 test3"
+  Dim iTarget As Word.Range: Set iTarget = doc_.doc_.Range(7, 10)
+  Dim iCat As InfoCategory: Set iCat = markup_.config_.categories_(1)
+  Dim iter As IteratorFormat
+  
+  Call Dev_NewCase("Invalid ID")
+  On Error Resume Next
+  Call Dev_ExpectNothing(doc_.GetFormatIterator(1337))
+  Call Dev_ExpectNoError
+  
+  Call Dev_NewCase("Past end")
+  On Error Resume Next
+  Call Dev_ExpectNothing(doc_.GetFormatIterator(iCat.id_, doc_.doc_.Range.End + 1))
+  Call Dev_ExpectNoError
+  
+  Call Dev_NewCase("No formatting")
+  On Error Resume Next
+  Set iter = doc_.GetFormatIterator(iCat.id_)
+  Call Dev_ExpectNotNothing(iter)
+  Call Dev_ExpectNoError
+  Call Dev_ExpectEQ(doc_.doc_.Range(0, 0), iter.Range)
+  Call Dev_ExpectNothing(iter.MoveNext)
+  Call Dev_ExpectNothing(iter.MovePrev)
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Valid category iter")
+  Call doc_.ApplyCategory(iCat, iTarget)
+  Set iter = doc_.GetFormatIterator(iCat.id_)
+  Call Dev_ExpectNotNothing(iter)
+  Call Dev_ExpectEQ(doc_.doc_.Range(0, 0), iter.Range)
+  Call Dev_ExpectEQ(iTarget, iter.MoveNext(), "Move next")
+  Call Dev_ExpectEQ(iTarget, iter.Range)
+  Call Dev_ExpectNothing(iter.MoveNext(), "Move next")
+  Call Dev_ExpectEQ(iTarget, iter.Range)
+  Call Dev_ExpectNothing(iter.MovePrev(), "Move prev")
+  Call Dev_ExpectEQ(iTarget, iter.Range)
+  
+  Call Dev_NewCase("Valid format")
+  Dim iTarget2 As Word.Range: Set iTarget2 = doc_.doc_.Range(13, 17)
+  Call iCat.GetFormat(doc_.doc_).ApplyToWordFont(iTarget2.Font)
+  Call Dev_ExpectEQ(iTarget2, iter.MoveNext(), "Move next")
+  Call Dev_ExpectEQ(iTarget, iter.MovePrev(), "Move prev")
+  
+  Call Dev_NewCase("Mixed format")
+  Dim iTarget3 As Word.Range: Set iTarget3 = doc_.doc_.Range(3, iTarget.Start)
+  Call iCat.GetFormat(doc_.doc_).ApplyToWordFont(iTarget3.Font)
+  Set iter = doc_.GetFormatIterator(iCat.id_)
+  Call Dev_ExpectEQ(doc_.doc_.Range(iTarget3.Start, iTarget.End), iter.MoveNext())
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+
+Public Function t_IteratorStyle()
+  On Error GoTo PROPAGATE_ERROR
+  ' =================12345678901234567
+  doc_.doc_.Range = "Test1 test2 test3"
+  Dim iTarget As Word.Range: Set iTarget = doc_.doc_.Range(7, 10)
+  Dim iCat As InfoCategory: Set iCat = markup_.config_.categories_(1)
+  Dim iter As IteratorStyle
+    
+  Call Dev_NewCase("Invalid ID")
+  On Error Resume Next
+  Call Dev_ExpectNothing(doc_.GetStylesIterator(1337))
+  Call Dev_ExpectNothing(doc_.GetPreciseIterator(1337))
+  Call Dev_ExpectNoError
+  
+  Call Dev_NewCase("Past end")
+  On Error Resume Next
+  Call Dev_ExpectNothing(doc_.GetStylesIterator(iCat.id_, doc_.doc_.Range.End + 1))
+  Call Dev_ExpectNothing(doc_.GetPreciseIterator(iCat.id_, doc_.doc_.Range.End + 1))
+  Call Dev_ExpectNoError
+  
+  Call Dev_NewCase("No formatting")
+  On Error Resume Next
+  Set iter = doc_.GetStylesIterator(iCat.id_)
+  Call Dev_ExpectNotNothing(iter)
+  Call Dev_ExpectNoError
+  Call Dev_ExpectEQ(doc_.doc_.Range(0, 0), iter.Range)
+  Call Dev_ExpectNothing(iter.MoveNext)
+  Call Dev_ExpectNothing(iter.MovePrev)
+
+  On Error Resume Next
+  Set iter = doc_.GetPreciseIterator(iCat.id_)
+  Call Dev_ExpectNotNothing(iter)
+  Call Dev_ExpectNoError
+  Call Dev_ExpectEQ(doc_.doc_.Range(0, 0), iter.Range)
+  Call Dev_ExpectNothing(iter.MoveNext)
+  Call Dev_ExpectNothing(iter.MovePrev)
+  On Error GoTo PROPAGATE_ERROR
+  
+  Call Dev_NewCase("Valid category iter")
+  Call doc_.ApplyCategory(iCat, iTarget)
+  Set iter = doc_.GetPreciseIterator(iCat.id_)
+  Call Dev_ExpectNotNothing(iter)
+  Call Dev_ExpectEQ(doc_.doc_.Range(0, 0), iter.Range)
+  Call Dev_ExpectEQ(iTarget, iter.MoveNext(), "Move next")
+  Call Dev_ExpectEQ(iTarget, iter.Range)
+  Call Dev_ExpectNothing(iter.MoveNext(), "Move next")
+  Call Dev_ExpectEQ(iTarget, iter.Range)
+  Call Dev_ExpectNothing(iter.MovePrev(), "Move prev")
+  Call Dev_ExpectEQ(iTarget, iter.Range)
+  
+  Call Dev_NewCase("Valid format")
+  Dim iTarget2 As Word.Range: Set iTarget2 = doc_.doc_.Range(13, 17)
+  Call iCat.GetFormat(doc_.doc_).ApplyToWordFont(iTarget2.Font)
+  Call Dev_ExpectNothing(iter.MoveNext(), "Move next")
+  Call Dev_ExpectNothing(iter.MovePrev(), "Move prev")
+  
+  Call Dev_NewCase("Multiple styles")
+  Dim iTarget3 As Word.Range: Set iTarget3 = doc_.doc_.Range(3, iTarget.Start)
+  Dim iTarget4 As Word.Range: Set iTarget4 = doc_.doc_.Range(iTarget.End, 12)
+  Dim iCat2 As InfoCategory: Set iCat2 = markup_.config_.GetAt(2)
+  Call doc_.ApplyCategory(iCat, iTarget3)
+  Call doc_.ApplyCategory(iCat2, iTarget4)
+  Set iter = New IteratorStyle: Call iter.Init(doc_.doc_, CColl(iCat.style_, iCat2.style_))
+  Call Dev_ExpectEQ(doc_.doc_.Range(iTarget3.Start, iTarget4.End), iter.MoveNext())
+  
+  Exit Function
+PROPAGATE_ERROR:
+  Call Dev_LogError(Err.Number, Err.Description)
+End Function
+

src/utils/interview/Declarations.bas

@@ -0,0 +1,25 @@
+Attribute VB_Name = "Declarations"
+Option Explicit
+Option Private Module
+
+Public Enum ItemStructure
+  IS_ID = 1
+  IS_PROBLEM = 2
+  IS_CONSEQUENCE = 3
+  IS_NOVELTY = 4
+  IS_EFFECT = 5
+End Enum
+
+Public Enum InputStruct
+  INPS_ID = 1
+  INPS_START = 2
+  INPS_FINISH = 3
+  INPS_TYPE = 4
+  INPS_TEXT = 5
+  INPS_COMMENT = 6
+End Enum
+
+Public Const DATA_DEFAULT_ID = "N/A"
+Public Const TYPE_NO_TYPE = 0
+
+Public Const SHT_DATA = "Äàííûå"

src/utils/interview/Main.bas

@@ -0,0 +1,27 @@
+Attribute VB_Name = "Main"
+Option Explicit
+
+Public Sub RunImport()
+  Dim sFileName$: sFileName = UserInteraction.PromptFileFilter( _
+                                ThisWorkbook.Path, _
+                                sDescription:="Òàáëèöà Excel", _
+                                sFilter:="*.xlsx;*.xls;*.xlsm")
+  If sFileName = vbNullString Then _
+    Exit Sub
+
+  Dim xlApp As New API_XLWrapper
+  If xlApp.OpenDocument(sFileName, bReadOnly:=True) Is Nothing Then
+    Call UserInteraction.ShowMessage(EM_IMPORT_FAILED)
+    Exit Sub
+  End If
+
+  Dim uiWrap As New API_XLWrapper: Call uiWrap.SetDocument(ThisWorkbook)
+  Call uiWrap.PauseUI
+  
+  Call ImportFrom(xlApp.Document)
+  Call xlApp.ReleaseDocument
+  
+  Call uiWrap.ResumeUI
+  
+  Call UserInteraction.ShowMessage(IM_IMPORT_OK)
+End Sub

src/utils/interview/MainImpl.bas

@@ -0,0 +1,70 @@
+Attribute VB_Name = "MainImpl"
+Option Explicit
+
+Public Function ImportFrom(wbSource As Excel.Workbook)
+  Dim dest As Excel.Worksheet: Set dest = ThisWorkbook.Sheets(SHT_DATA)
+  Dim src As Excel.Worksheet: Set src = wbSource.Sheets(1)
+  
+  Dim rowOut&: rowOut = 2
+  Do While dest.Cells(rowOut, 1) <> vbNullString
+    rowOut = rowOut + 1
+  Loop
+  
+  Dim idRows As New Collection
+  Dim rowIn&: rowIn = 2
+  Dim lastType&: lastType = TYPE_NO_TYPE
+  Dim lastEnd&: lastEnd = 0
+  Dim lastID$: lastID = vbNullString
+  Dim targetRow&
+  Do While src.Cells(rowIn, 1) <> vbNullString
+    Dim sID$: sID = src.Cells(rowIn, INPS_COMMENT)
+    Dim nColumn&: nColumn = TypeToStruct(src.Cells(rowIn, INPS_TYPE))
+    
+    If sID = vbNullString Then
+      sID = DATA_DEFAULT_ID
+      targetRow = rowOut
+      rowOut = rowOut + 1
+    ElseIf InCollection(sID, idRows) Then
+      targetRow = idRows.Item(sID)
+    Else
+      Call idRows.Add(rowOut, sID)
+      targetRow = rowOut
+      rowOut = rowOut + 1
+    End If
+    
+    dest.Cells(targetRow, IS_ID) = sID
+    If sID = lastID And src.Cells(rowIn, INPS_TYPE) = lastType And src.Cells(rowIn, INPS_START) = lastEnd Then
+      Call ConcatinateCell(dest.Cells(targetRow, nColumn), src.Cells(rowIn, INPS_TEXT).Text)
+    Else
+      Call AddToCell(dest.Cells(targetRow, nColumn), src.Cells(rowIn, INPS_TEXT).Text)
+    End If
+    
+    lastType = src.Cells(rowIn, INPS_TYPE)
+    lastID = sID
+    lastEnd = src.Cells(rowIn, INPS_FINISH)
+    rowIn = rowIn + 1
+  Loop
+End Function
+
+' ==========
+Private Function TypeToStruct(styleType&) As ItemStructure
+  TypeToStruct = styleType + 1
+End Function
+
+Private Function AddToCell(target As Excel.Range, sData$)
+  Dim newTxt$: newTxt = sData
+  If target.Text <> vbNullString Then
+    newTxt = target.Text & Chr(10) & "------" & Chr(10) & sData
+  End If
+  target = newTxt
+  target.WrapText = False
+End Function
+
+Private Function ConcatinateCell(target As Excel.Range, sData$)
+  Dim newTxt$: newTxt = sData
+  If target.Text <> vbNullString Then
+    newTxt = target.Text & Chr(10) & newTxt
+  End If
+  target = newTxt
+  target.WrapText = False
+End Function

src/utils/interview/z_UIMessages.bas

@@ -0,0 +1,57 @@
+Attribute VB_Name = "z_UIMessages"
+' Messaging module
+Option Private Module
+Option Explicit
+
+Public Enum MsgCode
+  MSG_OK = 0
+  
+  EM_IMPORT_FAILED
+  
+ IM_IMPORT_OK
+
+'  QM_CLEAR_BEFORE_READD
+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_IMPORT_FAILED
+    Call MsgBox("Îøèáêà ïðè îòêðûòèè ôàéëà", vbExclamation)
+  
+  Case IM_IMPORT_OK
+    Call MsgBox("Äàííûå çàãðóæåíû èç ôàéëà", vbInformation)
+    
+  Case Else
+    Call MsgBox("Invalid message code", vbCritical)
+  End Select
+End Function
+
+Public Function UIAskQuestion(theCode As MsgCode, ParamArray params() As Variant) As Boolean
+  Dim unwrapped As Variant: unwrapped = params
+  unwrapped = FixForwardedParams(unwrapped)
+  
+  Dim answer&: answer = vbNo
+  Select Case theCode
+ ' Case QM_CLEAR_BEFORE_READD
+ '   answer = MsgBox("Äàííûé äîêóìåíò óæå äîáàâëåí â áàçó. Óäàëèòü âñå åãî äàííûå ïåðåä îáíîâëåíèåì?", vbYesNo + vbQuestion)
+        
+  Case Else
+    Call MsgBox("Invalid message code", vbCritical)
+  End Select
+  UIAskQuestion = answer = vbYes
+End Function

ui/aggregator/.rels

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

ui/aggregator/customUI.xml

@@ -0,0 +1,31 @@
+<?xml version="1.0" encoding="utf-8"?>
+<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
+	<ribbon>
+	<tabs>
+	<tab id="MarkupAggregator" label="Концепт.Разметка">
+	<group id="Actions" label="Действия">
+		<button id="ImportExcel" size="large" 
+			label="Добавить данные"
+			supertip="Загрузить данные из выгруженной разметки" 
+			imageMso="ExportExcel"
+			onAction="OnRibbonBtn"/>
+		<button id="ImportWord" size="large" 
+			label="Добавить документ"
+			supertip="Загрузить данные из размеченного документа" 
+			imageMso="ExportWord"
+			onAction="OnRibbonBtn"/>
+		<button id="FollowLink" size="large" 
+			label="Показать документ"
+			supertip="Открыть размеченный фрагмент в документе" 
+			imageMso="PivotTableGroupSelection"
+			onAction="OnRibbonBtn"/>
+		<button id="ClearAll" size="large" 
+			label="Очистить"
+			supertip="Удалить все данные" 
+			imageMso="ClearGrid"
+			onAction="OnRibbonBtn"/>
+	</group>
+	</tab>
+	</tabs>
+	</ribbon>
+</customUI>

ui/markup/.rels

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

ui/markup/customUI.xml

@@ -0,0 +1,136 @@
+<?xml version="1.0" encoding="utf-8"?>
+<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
+	onLoad="MUC_LoadRibbon" >
+	<ribbon>
+	<tabs>
+	<tab id="Markup" label="РАЗМЕТКА">
+	<group id="Categories" label="Разметка">
+		<dropDown id="ConfigPicker" sizeString="WWWWWWWWWWWWW"
+			label = "Конфиг"
+			getItemCount="MUC_ConfigCount"
+			getItemLabel="MUC_ConfigLabel"
+			getSelectedItemIndex="MUC_ConfigSelected"
+			onAction ="MUC_ConfigChange"/>
+		<dropDown id="CategoryPicker" sizeString="WWWWWWWWWWWWW"
+			label = "Категория"
+			getItemCount="MUC_CatsCount"
+			getItemLabel="MUC_CatsLabel"
+			getSelectedItemIndex="MUC_CatsSelected"
+			onAction ="MUC_CatsChange"/>
+			
+		<buttonGroup id="MarkupEditBtns">
+			<button id="NextCategory"
+				supertip="Следующая категория [Ctrl+Shift+A]"
+				imageMso="_3DPerspectiveDecrease"
+				onAction="MUC_OnBtn"/>
+			<button id="PrevCategory"
+				supertip="Предыдущая категория [Ctrl+Shift+D]"
+				imageMso="_3DPerspectiveIncrease"
+				onAction="MUC_OnBtn"/>
+			<button id="ApplyCategory"
+				supertip="Применить категорию к выделенному фрагменту [Ctrl+Shift+Q]"
+				imageMso="FontsReplaceFonts"
+				onAction="MUC_OnBtn"/>
+			<button id="AddCategory"
+				supertip="Добавить категорию в выделенный фрагмент к уже имеющимся [Ctrl+Shift+E]"
+				imageMso="AddAccount"
+				onAction="MUC_OnBtn"/>
+			<button id="RemoveMarkup"
+				supertip="Снять все шрифтовые выделения с выделенного фрагмента [Ctrl+Shift+W]"
+				imageMso="Clear"
+				onAction="MUC_OnBtn"/>
+			<button id="HighlightCategory"
+				supertip="Выделить все вхождения категории"
+				imageMso="HighlighterMode"
+				onAction="MUC_OnBtn"/>
+			<button id="UnhighlightCategory"
+				supertip="Снять выделение со всех вхождений категории"
+				imageMso="HighlightClear"
+				onAction="MUC_OnBtn"/>
+			<button id="GetCategory"
+				supertip="Определить категорию для выделенного фрагмента"
+				imageMso="TentativeAcceptInvitation"
+				onAction="MUC_OnBtn"/>
+		</buttonGroup>
+		
+		<button id="OpenConfig" size="large"
+			label="Изменить конфиг"
+			supertip="Открыть конфигурацию"
+			imageMso="GroupViews"
+			onAction="MUC_OnBtn"/>
+		<button id="SyncStyles" size="large"
+			label="Обновить стили"
+			supertip="Загрузки стили из конфигурации в активный документ"
+			imageMso="GroupCalendarOptions"
+			onAction="MUC_OnBtn"/>
+	</group>
+
+	<group id="Document" label="Навигация">
+		<button id="NextFragment"
+			label="Следующий"
+			supertip="Перейти к следующему фрагменту выбранной категории [Ctrl+Shift+Z]"
+			imageMso="TableColumnsInsertRight"
+			onAction="MUC_OnBtn"/>
+		<button id="PreviousFragment"
+			label="Предыдущий"
+			supertip="Перейти к предыдущему фрагменту выбранной категории [Ctrl+Shift+X]"
+			imageMso="TableColumnsInsertLeft"
+			onAction="MUC_OnBtn"/>
+		
+		<separator id="sep1"/>
+		
+		<button id="HideCategory"
+			label="Скрыть"
+			supertip="Скрыть все вхождения выбранной категории"
+			imageMso="VisibilityHidden"
+			onAction="MUC_OnBtn"/>
+		<button id="ShowCategory"
+			label="Отобразить"
+			supertip="Отобразить все вхождения выбранной категории"
+			imageMso="VisibilityVisible"
+			onAction="MUC_OnBtn"/>
+	</group>
+
+	<group id="ExportImport" label="Экспорт и Импорт">
+		<button id="ExtractVisible" size="large"
+			label="Извлечь видимый"
+			supertip="Экспорт нескрытых фрагментов текста"
+			imageMso="AddResourcesFromActiveDirectory"
+			onAction="MUC_OnBtn"/>
+		<button id="ExtractCategory" size="large"
+			label="Извлечь категорию"
+			supertip="Экспорт фрагментов категории"
+			imageMso="CopySplitButton"
+			onAction="MUC_OnBtn"/>
+		
+		<button id="ExportMarkedText" size="large"
+			label="Экспорт текста"
+			supertip="Экспорт размеченного текста"
+			imageMso="ExportTextFile"
+			onAction="MUC_OnBtn"/>
+		<button id="ExportMarkup"
+			label="Экспорт разметки"
+			supertip="Экспорт описания разметки"
+			imageMso="MindMapExportData"
+			onAction="MUC_OnBtn"/>
+		<button id="ImportMarkup"
+			label="Импорт разметки"
+			supertip="Применение описания разметки к текущему тексту"
+			imageMso="MindMapImportData"
+			onAction="MUC_OnBtn"/>
+		<button id="ExportHighlights"
+			label="Экспорт маркеров"
+			supertip="Выгрузка выделений маркером в форме описания разметки"
+			imageMso="AutoSummaryViewByHighlight"
+			onAction="MUC_OnBtn"/>
+			
+		<button id="ViewHelp" size="large"
+			label="Справка"
+			supertip="Вызов справки"
+			imageMso="Info"
+			onAction="MUC_OnBtn"/>
+	</group>
+	</tab>
+	</tabs>
+	</ribbon>
+</customUI>

ui/markup/customizations.xml

@@ -0,0 +1,2 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<wne:tcg xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships" xmlns:wne="http://schemas.microsoft.com/office/word/2006/wordml"><wne:keymaps><wne:keymap wne:kcmPrimary="0341"><wne:macro wne:macroName="CONCEPTMARKUP.MAIN.MU_NEXTCATEGORY"/></wne:keymap><wne:keymap wne:kcmPrimary="0344"><wne:macro wne:macroName="CONCEPTMARKUP.MAIN.MU_PREVCATEGORY"/></wne:keymap><wne:keymap wne:kcmPrimary="0345"><wne:macro wne:macroName="CONCEPTMARKUP.MAIN.MU_ADDCATEGORY"/></wne:keymap><wne:keymap wne:kcmPrimary="0351"><wne:macro wne:macroName="CONCEPTMARKUP.MAIN.MU_APPLYCATEGORY"/></wne:keymap><wne:keymap wne:kcmPrimary="0357"><wne:macro wne:macroName="CONCEPTMARKUP.MAIN.MU_CLEARFRAGMENT"/></wne:keymap><wne:keymap wne:kcmPrimary="0358"><wne:macro wne:macroName="CONCEPTMARKUP.MAIN.MU_GOTOPREV"/></wne:keymap><wne:keymap wne:kcmPrimary="035A"><wne:macro wne:macroName="CONCEPTMARKUP.MAIN.MU_GOTONEXT"/></wne:keymap></wne:keymaps><wne:toolbars><wne:toolbarData r:id="rId1"/></wne:toolbars></wne:tcg>