Initial commit

VBAMake.txt

@@ -0,0 +1,38 @@
+# == Properties Section ==
+# configuration properties
+# use .ini format to define properties
+# mandatory properties: name, artifact_home, source_home
+
+id = MasterText
+name = Мастер Текстов
+description = Автоматическое редактирование текстов
+artifact_home = Мастер Текстов
+source_home = MasterText
+install_home = \\fs1.concept.ru\projects\10 Автоматизация деятельности\01 Высокие технологии\ВТ-04 Мастер текстов
+
+%%
+# === Build section ===
+# Available commands:
+#   build LOCAL_MANIFEST
+#   copy LOCAL_SOURCE -> [LOCAL_ARTIFACT]
+#   save_as LOCAL_ARTIFACT -> LOCAL_ARTIFACT
+#   run LOCAL_SOURCE.bat
+
+build script\masterManifest.txt
+
+copy distr\!!Листовка.docx
+copy distr\!Руководство пользователя.docx
+copy distr\banned-words.txt
+
+%%
+# === Install section ==
+# Available commands:
+#	install LOCAL_ARTIFACT -> [INSTALL_PATH]
+#	add_template LOCAL_ARTIFACT -> [LOCAL_TEMPLATE]
+#   run LOCAL_ARTIFACT.bat <- [PARAMETERS]
+#	run APPLICATION <- [PARAMETERS]
+
+install Мастер текстов.xlsm
+install !!Листовка.docx
+install !Руководство пользователя.docx
+install banned-words.txt

VERSION

@@ -0,0 +1 @@
+1.2.0

distr/banned-words.txt

@@ -0,0 +1,125 @@
+никогда
+нигде
+эффективность
+эффективности
+эффективностью
+минимальный
+минимального
+минимальная
+минимальной
+минимальному
+минимальным
+минимальные
+минимальными
+минимальному
+максимальный
+максимальная
+максимальные
+максимальным
+максимальному
+максимальной
+максимальными
+минимизация
+минимизации
+минимизацией
+глобальный
+глобальная
+глобальные
+глобальным
+глобальной
+глобальными
+глобальному
+беспрецедентный
+беспрецедентная
+беспрецедентные
+беспрецедентным
+беспрецедентному
+беспрецедентными
+беспрецедентной
+предельный
+предельная
+предельные
+предельным
+предельному
+предельной
+предельными
+уникальный
+уникальная
+уникальные
+уникальным
+уникальными
+уникальному
+уникальной
+реальный
+реальная
+реальные
+реальным
+реальными
+реальному
+реальной
+всегда
+подавляющий
+подавляющего
+подавляющим
+подавляющему
+подавляющем
+подавляющая
+подавляющей
+подавляющие
+подавляющим
+подавляющих
+было
+был
+была
+были
+эффективный
+эффективная
+эффективное
+эффективные
+эффективным
+эффективной
+эффективными
+эффективных
+эффективному
+эффективном
+неэффективный
+неэффективная
+неэффективное
+неэффективные
+неэффективным
+неэффективной
+неэффективными
+неэффективных
+неэффективному
+неэффективном
+минимально
+максимально
+эффективно
+недавно
+существует
+существуют
+существовать
+текущий
+текущая
+текущие
+текущему
+текущей
+текущим
+текущими
+текущих
+постоянно
+очевидно
+просто
+сразу
+любой бред
+любого бреда
+любому бреду
+любым бредом
+любом бреде
+какой-то
+какая-то
+какие-то
+какому-то
+какой-то
+каким-то
+какими-то

script/masterManifest.txt

@@ -0,0 +1,83 @@
+# == 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_UserInteraction.cls
+	API_WordWrapper.cls
+	API_XLWrapper.cls
+	
+word
+	ex_Word.bas
+	API_WordEditGuard.cls
+	
+utility
+	ex_VBA.bas
+	API_Timer.cls
+	API_Config.cls
+	API_JSON.cls
+	
+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
+	DevHelper.bas
+	
+	Declarations.bas
+	Main.bas
+	MainImpl.bas
+	z_UIRibbon.bas
+	z_UIMessages.bas
+	
+	SelectSourceDlg.frm
+	RulesDlg.frm
+	
+	UIState.cls
+	
+	DB_Rules.cls
+	IteratorRule.cls
+	
+	RulesProcessor.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
+
+.rels -> _rels\.rels
+customUI.xml -> customUI\customUI.xml
+
+%%
+# === References Section ===
+# List dependencies in one of the formats
+# global : GLOBAL_NAME
+# guid : {REGISTERED_GUID}
+# file : PATH_TO_LIBRARY
+
+global : VBScript_RegExp_55
+global : Scripting
+global : Shell32
+global : Word
+global : MSForms
+global : ADODB

src/DB_Rules.cls

@@ -0,0 +1,54 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "DB_Rules"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private data_ As Excel.Worksheet
+
+Public Function Init(target As Excel.Worksheet)
+  Set data_ = target
+End Function
+
+Public Function IBegin() As IteratorRule
+  Set IBegin = New IteratorRule
+  Call IBegin.Init(data_)
+End Function
+
+Public Function ILast() As IteratorRule
+  Set ILast = New IteratorRule
+  Call ILast.Init(data_)
+  Call ILast.GoLast
+End Function
+
+Public Function INew() As IteratorRule
+  Set INew = New IteratorRule
+  Call INew.Init(data_)
+  Call INew.GoLast
+  Call INew.Increment
+End Function
+
+Public Function Count() As Long
+  Count = ILast.row_ - IBegin.row_ + 1
+End Function
+
+Public Function FindRule(sID$) As IteratorRule
+  Dim iRule As IteratorRule: Set iRule = IBegin
+  If iRule.GoToID(sID) Then _
+    Set FindRule = iRule
+End Function
+
+Public Function ClearStats()
+  Dim iRule As IteratorRule: Set iRule = IBegin
+  Do Until iRule.IsDone
+    iRule.ErrorsCount = 0
+    iRule.FixesCount = 0
+    iRule.TimeSpent = 0
+    Call iRule.Increment
+  Loop
+End Function

src/Declarations.bas

@@ -0,0 +1,68 @@
+Attribute VB_Name = "Declarations"
+Option Explicit
+
+Public Const FIRST_DATA_ROW = 2
+
+Public Const STYLE_ERROR_COLOR = wdBrightGreen
+Public Const STYLE_ERROR_PREFIX = "!ERROR_"
+
+Public Const FLAG_VALUE_ON = "äà"
+Public Const FLAG_VALUE_OFF = "íåò"
+
+Public Const APP_HELP = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\01 Âûñîêèå òåõíîëîãèè\ÂÒ-04 Ìàñòåð òåêñòîâ\!Ðóêîâîäñòâî ïîëüçîâàòåëÿ.docx"
+
+Public Const CONCEPT_SERVER_HOME = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\!Concept\models\"
+Public Const CONCEPT_LOCAL_HOME = ".concept\models\"
+Public Const CONCEPT_BANNED_WORDS = "banned-words.txt"
+
+' Èìåíà ëèñòîâ
+Public Const SHEET_START = "Start"
+Public Const SHEET_UI = "Óïðàâëåíèå"
+Public Const SHEET_RULES = "Ïðàâèëà"
+
+' Èìåíîâàííûå äèàïàçîíû
+Public Const CELL_PAGE_COUNT = "c_PageCount"
+Public Const CELL_SINGLE_RULE = "c_TheOnlyRule"
+Public Const CELL_FIXES_COUNT = "c_FixesCount"
+Public Const CELL_ERROR_COUNT = "c_ErrCount"
+
+Public Const RULES_COUNT_NAME = "c_RuleCount"
+Public Const RULES_GROUP_NAME = "r_RuleGroup"
+Public Const CELL_TARGET_PATH = "c_DocPath"
+Public Const STYLE_TEMPLATE_NAME = "c_StyleTemplate"
+
+Public Const EXCEPTION_COUNT_NAME = "c_ExceptionBMCount"
+Public Const EXCEPTION_WORD_COUNT_NAME = "c_ExceptionWordCount"
+Public Const STYLE_COUNT_NAME = "c_StyleCount"
+Public Const STYLE_DELETE_NAME = "c_StyleDelete"
+Public Const STYLE_RENAME_NAME = "c_StyleRename"
+
+Public Enum AddinErrors
+  ERR_CANNOT_INIT = vbObjectError + 1000
+End Enum
+
+' _R_ - Rules
+Public Enum RuleStruct
+  [_First] = 1
+  
+  S_R_ID = 1
+  S_R_NAME = 2
+  S_R_ENABLED = 3
+  S_R_APPLY = 4
+  S_R_GROUP = 5
+  S_R_DESCRIPTION = 6
+  S_R_ERRORS = 7
+  S_R_FIXES = 8
+  S_R_TIME = 9
+  
+  [_Last] = 9
+End Enum
+
+' _P_ - parameters
+Public Enum ParamsStruct
+  [_First] = 1
+  
+  S_P_BANNED_WORDS = 1
+  
+  [_Last] = 1
+End Enum

src/DevHelper.bas

@@ -0,0 +1,21 @@
+Attribute VB_Name = "DevHelper"
+Option Explicit
+
+Public Function Dev_PrepareSkeleton()
+  Call AccessRules.ClearStats
+  Call AccessUI.LogStylesData(0, 0, 0)
+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
+  End Select
+End Function

src/IteratorRule.cls

@@ -0,0 +1,127 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "IteratorRule"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Public row_ As Long
+Private data_ As Excel.Worksheet
+
+Public Sub Init(target As Excel.Worksheet, Optional tRow& = FIRST_DATA_ROW)
+  Set data_ = target
+  row_ = tRow
+End Sub
+
+Public Function Increment(Optional inc& = 1)
+  If row_ + inc > 0 Then _
+    row_ = row_ + inc
+End Function
+
+Public Function GoFirst()
+  row_ = FIRST_DATA_ROW
+End Function
+
+Public Function GoLast()
+  row_ = data_.Columns(S_R_ID).Find(vbNullString, LookAt:=xlWhole).Row - 1
+End Function
+
+Public Function GoToID(sID$) As Boolean
+  Dim rFound As Excel.Range: Set rFound = data_.Columns(S_R_ID).Find(sID, LookAt:=xlWhole)
+  If rFound Is Nothing Then
+    GoToID = False
+  Else
+    GoToID = True
+    row_ = rFound.Row
+  End If
+End Function
+
+Public Function IsDone() As Boolean
+  IsDone = data_.Cells(row_, S_R_ID) = vbNullString
+End Function
+
+Public Function RemoveRow()
+  Call data_.Rows(row_).Delete
+End Function
+
+'===== Propertiy Get =====
+Public Property Get RuleID() As String
+  RuleID = data_.Cells(row_, S_R_ID)
+End Property
+
+Public Property Get RuleName() As String
+  RuleName = data_.Cells(row_, S_R_NAME)
+End Property
+
+Public Property Get Enabled() As Boolean
+  Enabled = data_.Cells(row_, S_R_ENABLED) = FLAG_VALUE_ON
+End Property
+
+Public Property Get ApplyFixes() As Boolean
+  ApplyFixes = data_.Cells(row_, S_R_APPLY) = FLAG_VALUE_ON
+End Property
+
+Public Property Get GroupName() As String
+  GroupName = data_.Cells(row_, S_R_GROUP)
+End Property
+
+Public Property Get Description() As String
+  Description = data_.Cells(row_, S_R_DESCRIPTION)
+End Property
+
+Public Property Get ErrorsCount() As Long
+  ErrorsCount = data_.Cells(row_, S_R_ERRORS)
+End Property
+
+Public Property Get FixesCount() As Long
+  FixesCount = data_.Cells(row_, S_R_FIXES)
+End Property
+
+Public Property Get TimeSpent() As Double
+  TimeSpent = data_.Cells(row_, S_R_TIME)
+End Property
+
+Public Property Get DescriptionLabel() As String
+  DescriptionLabel = Fmt("{1}: {2}", RuleID, RuleName)
+End Property
+
+' ==== Property Let ====
+Public Property Let RuleID(newVal$)
+  data_.Cells(row_, S_R_ID) = newVal
+End Property
+
+Public Property Let RuleName(newVal$)
+  data_.Cells(row_, S_R_NAME) = newVal
+End Property
+
+Public Property Let Enabled(newVal As Boolean)
+  data_.Cells(row_, S_R_ENABLED) = IIf(newVal, FLAG_VALUE_ON, FLAG_VALUE_OFF)
+End Property
+
+Public Property Let ApplyFixes(newVal As Boolean)
+  data_.Cells(row_, S_R_APPLY) = IIf(newVal, FLAG_VALUE_ON, FLAG_VALUE_OFF)
+End Property
+
+Public Property Let GroupName(newVal$)
+  data_.Cells(row_, S_R_GROUP) = newVal
+End Property
+
+Public Property Let Description(newVal$)
+  data_.Cells(row_, S_R_DESCRIPTION) = newVal
+End Property
+
+Public Property Let ErrorsCount(newVal&)
+  data_.Cells(row_, S_R_ERRORS) = newVal
+End Property
+
+Public Property Let FixesCount(newVal&)
+  data_.Cells(row_, S_R_FIXES) = newVal
+End Property
+
+Public Property Let TimeSpent(newVal As Double)
+  data_.Cells(row_, S_R_TIME) = newVal
+End Property

src/Main.bas

@@ -0,0 +1,264 @@
+Attribute VB_Name = "Main"
+Option Explicit
+
+Public Sub RunInputFile()
+  Call AccessUI.InputTargetFile
+End Sub
+
+Public Sub RunInputOpen()
+  Call AccessUI.ChooseTargetFileFromOpened
+End Sub
+
+Public Sub RunOpenTarget()
+  Call ActivateCurrentDocument
+End Sub
+
+Public Sub RunInputTemplate()
+  Call AccessUI.InputTemplate
+End Sub
+
+Public Sub RunCheckup()
+  Call ExecuteAll(bApplyFix:=False)
+End Sub
+
+Public Sub RunFixErrors()
+  Call ExecuteAll(bApplyFix:=True)
+End Sub
+
+Public Sub RunRecovery()
+' Âîññòàíàâëèâàåì ïàðàìåòðû ïîñëå àâàðèéíîãî âûõîäà
+  Dim xlUI As New API_XLWrapper: Call xlUI.SetDocument(ThisWorkbook)
+  Call xlUI.ResumeUI
+End Sub
+
+Public Sub ExecuteSingle(Optional bApplyFix As Boolean = True)
+' Çàïóñêàåì àíàëèç äëÿ îäíîãî ïðàâèëà
+  Dim target As API_WordEditGuard: Set target = PrepareTargetDocument
+  If target Is Nothing Then _
+    Exit Sub
+  
+  AccessUI.PageCount = target.Document.ComputeStatistics(wdStatisticPages)
+  
+  Dim sRuleID$: sRuleID = AccessUI.SingleRuleID
+  Dim dbRules As DB_Rules: Set dbRules = AccessRules
+  Dim iRule As IteratorRule: Set iRule = dbRules.FindRule(sRuleID)
+  Dim iProcessor As RulesProcessor: Set iProcessor = AccessProcessor
+  
+  Dim xlUI As New API_XLWrapper: Call xlUI.SetDocument(ThisWorkbook)
+  Call xlUI.PauseUI
+  Call target.BeginEdit(AccessUI.RevisionEnabled)
+  
+  Call dbRules.ClearStats
+  
+  Call iProcessor.Init(target.Wrapper, AccessUI.ProduceRulesConfig)
+  Dim nMilliseconds&
+  nMilliseconds = RunRule(iProcessor, iRule, bApplyFix:=bApplyFix, DoDebug:=True)
+  
+  Call iProcessor.FinalizeProcessing
+  Call target.EndEdit
+  Call xlUI.ResumeUI
+  
+  If AccessUI.ShowDiff Then _
+    Call target.SaveAndShowDiff
+   
+  Call Application.ActiveWorkbook.Activate
+  Call UserInteraction.ShowMessage(IM_RULES_COMPLETE, nMilliseconds, AccessUI.ErrorsCount, AccessUI.FixesCount)
+End Sub
+
+Public Sub RunFixStyles()
+' Àíàëàëèçèðóåì è èñïðàâëÿåì ñòèëè
+  Dim target As API_WordEditGuard: Set target = PrepareTargetDocument
+  If target Is Nothing Then _
+    Exit Sub
+  
+  Dim wordWrap As New API_WordWrapper
+  Dim templateDoc As Word.Document:  Set templateDoc = wordWrap.OpenDocument(AccessUI.TemplatePath)
+  If templateDoc Is Nothing Then _
+    Exit Sub
+  
+  Call target.Document.ActiveWindow.Activate
+  
+  Call CSE_ProgressBar.Init("Àâòîìàòèçèðîâàííàÿ ñèñòåìà òåñòèðîâàíèÿ", _
+            sHeader:="Îáðàáîòêà ñòèëåé", _
+            maxVal:=target.Document.Styles.Count)
+  Call CSE_ProgressBar.ShowModeless
+  
+  Call ProcessStyles(target.Document, templateDoc)
+  
+  Call templateDoc.Close(SaveChanges:=False)
+  Call Unload(CSE_ProgressBar)
+  Call UserInteraction.ShowMessage(IM_STYLES_FIXED)
+End Sub
+
+Public Sub RunFixManualFormat()
+' Óäàëÿåì ïðÿìîå ôîðìàòèðîâàíèå
+  Dim target As API_WordEditGuard: Set target = PrepareTargetDocument
+  If target Is Nothing Then _
+    Exit Sub
+  Dim iDoc As Word.Document: Set iDoc = target.Document
+  
+  Call target.BeginEdit(AccessUI.RevisionEnabled)
+  
+  Call CSE_ProgressBar.Init("Àâòîìàòèçèðîâàííàÿ ñèñòåìà òåñòèðîâàíèÿ", _
+            sHeader:="Îáðàáîòêà òåêñòà äîêóìåíòà", _
+            maxVal:=iDoc.Range.End)
+  Call CSE_ProgressBar.ShowModeless
+  
+  Call SelectVisibleText(iDoc)
+  
+  With iDoc
+    .Range.NoProofing = False
+    .Application.Selection.ClearCharacterDirectFormatting
+    .Application.Selection.ClearParagraphDirectFormatting
+    .Range.NoProofing = True
+    Call .Paragraphs(1).Range.Select
+  End With
+  
+  Call target.EndEdit
+  Call Unload(CSE_ProgressBar)
+  
+  Call MsgBox("Óäàëåíèå ðó÷íîãî ôîðìàòèðîâàíèÿ ïðîøëî óñïåøëî")
+End Sub
+
+Public Sub RunChooseRules()
+  Dim dbRules As DB_Rules: Set dbRules = AccessRules
+
+  Call RulesDlg.Init(dbRules)
+  Call RulesDlg.Show
+  If RulesDlg.isCanceled_ Then _
+    Exit Sub
+  Dim iSelected As Scripting.Dictionary: Set iSelected = RulesDlg.GetSelectedIDList()
+  Call Unload(RulesDlg)
+  
+  Dim iRule As IteratorRule: Set iRule = dbRules.IBegin
+  Do Until iRule.IsDone
+    iRule.Enabled = iSelected.Exists(iRule.RuleID)
+    Call iRule.Increment
+  Loop
+End Sub
+
+Public Sub OpenBannedWords()
+  Dim fso As New Scripting.FileSystemObject
+  Dim sFile$: sFile = CONCEPT_SERVER_HOME & CONCEPT_BANNED_WORDS
+  If Not fso.FileExists(sFile) Then
+    Call UserInteraction.ShowMessage(EM_MISSING_FILE, sFile)
+    Exit Sub
+  End If
+  Dim oShell As New Shell32.Shell
+  Call oShell.Open(sFile)
+End Sub
+
+Public Sub UpdateBannedWords()
+  If TryUpdateBannedWords Then
+    Call UserInteraction.ShowMessage(IM_UPDATE_BANNED_SUCCESS)
+  Else
+    Call UserInteraction.ShowMessage(IM_UPDATE_BANNED_FAIL)
+  End If
+End Sub
+
+Public Sub ClearWordFormat()
+' Î÷èñòêà ôîðìàòèðîâàíèÿ / êîììåíòàðèåâ â äîêóìåíòå
+  Dim target As API_WordEditGuard: Set target = PrepareTargetDocument
+  If target Is Nothing Then _
+    Exit Sub
+  
+  Call target.BeginEdit(AccessUI.RevisionEnabled)
+  Call target.EndEdit
+  
+  Call UserInteraction.ShowMessage(IM_FORMAT_CLEARED)
+End Sub
+
+Public Sub ChangeEncoding()
+  Call ChangeCharset(AccessUI.TargetPath, Range("c_CodeInput"), Range("c_CodeOutput"))
+  Call MsgBox("Ïåðåêîäèðîâêà ïðîøëà óñïåøíî", vbInformation)
+End Sub
+
+Public Sub RunHelp()
+  Dim iWord As New API_WordWrapper
+  Dim iHelp As Word.Document: Set iHelp = iWord.OpenDocument(APP_HELP, bReadOnly:=True)
+  If iHelp Is Nothing Then _
+    Exit Sub
+
+  With iHelp
+    .ActiveWindow.View.ReadingLayout = False
+    Call .Application.Activate
+  End With
+End Sub
+
+' ==========
+Private Function PrepareTargetDocument() As API_WordEditGuard
+  Dim applWord As API_WordWrapper: Set applWord = OpenTargetDocument
+  If applWord Is Nothing Then _
+    Exit Function
+  
+  If applWord.Document.ReadOnly Then ' ReadOnly êîíôëèêòóåò ñ íàñòðîéêîé âíåñåíèÿ èçìåíåíèé
+    Call UserInteraction.ShowMessage(EM_DOC_READONLY)
+    Call applWord.Document.ActiveWindow.Activate
+    Exit Function
+  End If
+  
+  If applWord.Document.Comments.Count > 0 Then
+    If Not UserInteraction.AskQuestion(QM_WARN_COMMENTS) Then _
+      Exit Function
+    Call applWord.Document.DeleteAllComments
+  End If
+  
+  If Not applWord.Document.Saved Then
+    If UserInteraction.AskQuestion(QM_SAVE_DOC) Then _
+      Call applWord.Document.Save
+  End If
+  
+  Set PrepareTargetDocument = New API_WordEditGuard
+  Call PrepareTargetDocument.Init(applWord)
+End Function
+
+Private Function ExecuteAll(Optional bApplyFix As Boolean = True)
+' Çàïóñê àíàëèçà ïî êàæäîìó èç âûáðàííûõ ïðàâèë
+  Dim target As API_WordEditGuard: Set target = PrepareTargetDocument
+  If target Is Nothing Then _
+    Exit Function
+  
+  AccessUI.PageCount = target.Document.ComputeStatistics(wdStatisticPages)
+  Dim dbRules As DB_Rules: Set dbRules = AccessRules
+  
+  Dim xlUI As New API_XLWrapper: Call xlUI.SetDocument(ThisWorkbook)
+  Call xlUI.PauseUI
+  Call target.BeginEdit(AccessUI.RevisionEnabled)
+  
+  Call AccessRules.ClearStats
+  
+  Call CSE_ProgressBar.Init("Àâòîìàòèçèðîâàííàÿ ñèñòåìà òåñòèðîâàíèÿ", sHeader:="Âûïîëíÿåòñÿ ïðîâåðêà, ïîäîæäèòå...", maxVal:=dbRules.Count, canInterrupt:=True)
+  Call CSE_ProgressBar.ShowModeless
+  
+  Dim iProcessor As RulesProcessor: Set iProcessor = AccessProcessor()
+  Call iProcessor.Init(target.Wrapper, AccessUI.ProduceRulesConfig)
+  
+  Dim wasInterrupted As Boolean: wasInterrupted = False
+  Dim nMilliseconds&: nMilliseconds = 0
+  Dim bFixFlag As Boolean
+  Dim iRule As IteratorRule: Set iRule = dbRules.IBegin
+  Do Until iRule.IsDone
+    If CSE_ProgressBar.Interrupted Then
+      wasInterrupted = True
+      Exit Do
+    End If
+      
+    If iRule.Enabled Then
+      CSE_ProgressBar.Description = iRule.DescriptionLabel
+      bFixFlag = bApplyFix And iRule.ApplyFixes
+      nMilliseconds = nMilliseconds + RunRule(iProcessor, iRule, bFixFlag, AccessUI.DoDebug)
+    End If
+    
+    Call CSE_ProgressBar.IncrementA
+    Call iRule.Increment
+  Loop
+  
+  CSE_ProgressBar.Description = "Ðàññòàíîâêà êîììåíòàðèåâ"
+  Call iProcessor.FinalizeProcessing
+  
+  Call Unload(CSE_ProgressBar)
+  Call target.EndEdit
+  Call xlUI.ResumeUI
+  
+  Call UserInteraction.ShowMessage(IM_RULES_COMPLETE, nMilliseconds, AccessUI.ErrorsCount, AccessUI.FixesCount)
+End Function

src/MainImpl.bas

@@ -0,0 +1,186 @@
+Attribute VB_Name = "MainImpl"
+Option Private Module
+Option Explicit
+
+Public Function AccessRules() As DB_Rules
+  Static s_Rules As DB_Rules
+  If s_Rules Is Nothing Then
+    Set s_Rules = New DB_Rules
+    Call s_Rules.Init(ThisWorkbook.Worksheets(SHEET_RULES))
+  End If
+  
+  Set AccessRules = s_Rules
+End Function
+
+Public Function AccessProcessor() As RulesProcessor
+  Static s_Processor As RulesProcessor
+  If s_Processor Is Nothing Then _
+    Set s_Processor = New RulesProcessor
+  Set AccessProcessor = s_Processor
+End Function
+
+Public Function LoadBannedWords() As Collection
+  Dim result As New Collection
+  Dim sLocal$: sLocal = VBA.Environ$("USERPROFILE") & "\" & CONCEPT_LOCAL_HOME & CONCEPT_BANNED_WORDS
+  Dim fso As New Scripting.FileSystemObject
+  If Not fso.FileExists(sLocal) Then
+    If Not TryUpdateBannedWords() Then
+      Call UserInteraction.ShowMessage(EM_MISSING_FILE, sLocal)
+      GoTo RETURN_EMPTY
+    End If
+  End If
+
+  Dim adoStream As New ADODB.Stream
+  adoStream.Charset = "utf-8"
+  Call adoStream.Open
+  Call adoStream.LoadFromFile(sLocal)
+  Dim sLines() As String: sLines = Split(adoStream.ReadText, vbCrLf)
+  Call adoStream.Close
+  
+  Dim nLine&
+  For nLine = LBound(sLines, 1) To UBound(sLines, 1) Step 1
+    Dim sText$: sText = sLines(nLine)
+    If sText <> vbNullString Then _
+      Call result.Add(sText)
+  Next nLine
+  
+RETURN_EMPTY:
+  Set LoadBannedWords = result
+End Function
+
+Public Function TryUpdateBannedWords() As Boolean
+  Dim sServer$: sServer = CONCEPT_SERVER_HOME & CONCEPT_BANNED_WORDS
+  Dim sLocal$: sLocal = VBA.Environ$("USERPROFILE") & "\" & CONCEPT_LOCAL_HOME & CONCEPT_BANNED_WORDS
+  TryUpdateBannedWords = CopyFileOrFolder(sSource:=sServer, sDestination:=sLocal)
+End Function
+
+Public Function OpenTargetDocument() As API_WordWrapper
+  Dim sFileName$: sFileName = AccessUI.TargetPath
+  If sFileName = "" Then
+    Call UserInteraction.ShowMessage(EM_PATH_EMPTY)
+    Exit Function
+  End If
+
+  Dim iWrapper As New API_WordWrapper
+  If Not iWrapper.OpenDocument(sFileName) Is Nothing Then _
+    Set OpenTargetDocument = iWrapper
+End Function
+
+Public Function ActivateCurrentDocument()
+  Dim appWord As API_WordWrapper: Set appWord = OpenTargetDocument
+  If appWord Is Nothing Then _
+    Exit Function
+  Call appWord.Document.ActiveWindow.Activate
+End Function
+
+Public Function RunRule(iProcessor As RulesProcessor, iRule As IteratorRule, bApplyFix As Boolean, Optional DoDebug As Boolean = False) As Double
+  Dim aTimer As New API_Timer: Call aTimer.Start
+  
+  If Not DoDebug Then _
+    On Error GoTo SHOW_FAILURE
+  Call iProcessor.RunRule(iRule.RuleID, bApplyFix)
+  If Not DoDebug Then _
+    On Error GoTo 0
+  GoTo LOG_RESULT
+
+SHOW_FAILURE:
+  Call UserInteraction.ShowMessage(EM_RULE_FAILED, iRule.RuleID)
+  
+LOG_RESULT:
+  iRule.TimeSpent = aTimer.TimeElapsed
+  iRule.ErrorsCount = iProcessor.errors_
+  iRule.FixesCount = iProcessor.fixes_
+  RunRule = iRule.TimeSpent
+End Function
+
+Public Function ProcessStyles(target As Word.Document, templateDoc As Word.Document)
+  Dim nCount&: nCount = target.Styles.Count
+  Dim nRenamed&: nRenamed = 0
+  Dim nRemoved&: nRemoved = 0
+  Dim aStyle As Word.Style
+  For Each aStyle In target.Styles
+    Dim sName$: sName = aStyle.NameLocal
+    If sName = "" Then
+      GoTo NEXT_STYLE
+    ElseIf aStyle.BuiltIn Then
+      nCount = nCount - 1
+      GoTo NEXT_STYLE
+    ElseIf WordStyleExists(templateDoc, sName) Then
+      GoTo NEXT_STYLE
+    ElseIf AccessUI.StylesDeleteUnused And Not WordStyleIsUsed(target, aStyle) Then
+      Call aStyle.Delete
+      nRemoved = nRemoved + 1
+      GoTo NEXT_STYLE
+    End If
+    
+    If AccessUI.StylesRename And Not sName Like STYLE_ERROR_PREFIX & "*" Then
+      sName = STYLE_ERROR_PREFIX & sName
+      aStyle.NameLocal = sName
+      aStyle.Priority = 1
+      nRenamed = nRenamed + 1
+    End If
+    If AccessUI.StylesFormat Then
+      aStyle.Font.ColorIndex = STYLE_ERROR_COLOR
+    End If
+
+NEXT_STYLE:
+    Call CSE_ProgressBar.IncrementA
+  Next aStyle
+  
+  Call AccessUI.LogStylesData(nCount, nRenamed, nRemoved)
+End Function
+
+Public Function ChangeCharset(sFile$, chSetInput$, chSetOutput$)
+  Dim adoStream  As New ADODB.Stream
+  With adoStream
+    .Charset = chSetInput
+    Call .Open
+    Call .LoadFromFile(sFile)
+    .Position = 0
+  End With
+  
+  Dim adoStreamOut As New ADODB.Stream
+  With adoStreamOut
+    .Charset = chSetOutput
+    Call .Open
+    Call .WriteText(adoStream.ReadText)
+    Call .SaveToFile(sFile, adSaveCreateOverWrite)
+    Call .Close
+  End With
+
+  Call adoStream.Close
+  Set adoStream = Nothing
+  Set adoStreamOut = Nothing
+End Function
+
+Public Function SelectVisibleText(target As Word.Document)
+' Âûäåëÿåì âåñü íå ñêðûòûé òåêñò â äîêóìåíòå
+  Call target.DeleteAllEditableRanges(wdEditorEveryone)
+  
+  Dim rFind As Word.Range:  Set rFind = target.Range
+  Dim nStart&:  nStart = -1
+  With rFind.Find
+    .Font.Hidden = False
+    .Format = True
+    .Text = "<*^0013"
+    .MatchWildcards = True
+    Do While .Execute
+      Call rFind.Editors.Add(wdEditorEveryone)
+      
+      If CSE_ProgressBar.Visible Then _
+        Call CSE_ProgressBar.SetA(rFind.End)
+
+      If nStart = rFind.Start Then  ' Ãàðàíòèðóåì, ÷òî íå çàöèêëèìñÿ
+        Debug.Print "Âûäåëåíèå âèäèìîãî òåêñòà çàöèêëèëîñü"
+        Exit Do
+      Else
+        nStart = rFind.Start
+      End If
+      
+      Call rFind.Collapse(wdCollapseEnd)
+    Loop
+  End With
+  
+  Call target.SelectAllEditableRanges(wdEditorEveryone)
+  Call target.DeleteAllEditableRanges(wdEditorEveryone)
+End Function

src/RulesDlg.frm

@@ -0,0 +1,79 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} RulesDlg 
+   Caption         =   "Ñôîðìèðóéòå ñïèñîê àêòèâíûõ ïðàâèë"
+   ClientHeight    =   9270.001
+   ClientLeft      =   45
+   ClientTop       =   375
+   ClientWidth     =   14325
+   OleObjectBlob   =   "RulesDlg.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "RulesDlg"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Private ids_ As Collection
+
+Public isCanceled_ As Boolean
+
+Private Sub UserForm_Initialize()
+  isCanceled_ = True
+  Call PositionInMiddle(Me)
+End Sub
+
+Public Function Init(iData As DB_Rules)
+  Call RulesLB.Clear
+  
+  Set ids_ = New Collection
+  
+  Dim iRule As IteratorRule: Set iRule = iData.IBegin
+  Dim sItem$, sID$
+  Do Until iRule.IsDone
+    sID = iRule.RuleID
+    sItem = iRule.DescriptionLabel
+    Call ids_.Add(sID)
+    Call RulesLB.AddItem(sItem)
+    If iRule.Enabled Then _
+      RulesLB.Selected(RulesLB.ListCount - 1) = True
+    
+    Call iRule.Increment
+  Loop
+End Function
+
+Public Function GetSelectedIDList() As Scripting.Dictionary
+  Dim result As New Scripting.Dictionary
+  Dim levelID$
+  Dim i&
+  For i = 0 To RulesLB.ListCount - 1 Step 1
+    If RulesLB.Selected(i) Then _
+      Call result.Add(ids_.Item(i + 1), i + 1)
+  Next i
+  Set GetSelectedIDList = result
+End Function
+
+Private Sub ClearListBtn_Click()
+  Dim nItem&
+  For nItem = 1 To RulesLB.ListCount
+    RulesLB.Selected(nItem - 1) = False
+  Next
+End Sub
+
+Private Sub SelectAllBtn_Click()
+  Dim nItem&
+  For nItem = 1 To RulesLB.ListCount
+    RulesLB.Selected(nItem - 1) = True
+  Next
+End Sub
+
+Private Sub OkBtn_Click()
+  isCanceled_ = False
+  Call Me.Hide
+End Sub
+
+Private Sub CancelBtn_Click()
+  isCanceled_ = True
+  Call Me.Hide
+End Sub

src/RulesProcessor.cls

@@ -0,0 +1,36 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "RulesProcessor"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private word_ As API_WordWrapper
+
+Public errors_ As Long
+Public fixes_ As Long
+
+Public Function Init(iWord As API_WordWrapper, iConfig As API_Config)
+  Set word_ = iWord
+  Dim sConfig$: sConfig = iConfig.SaveToJSON
+  Dim sFile$: sFile = iWord.Document.FullName
+  If Not word_.Run("RulesAccess.InitProcessor", sFile, sConfig) Then _
+    Call Err.Raise(ERR_CANNOT_INIT)
+End Function
+
+Public Function RunRule(sRuleID$, Optional bApplyFix As Boolean = True)
+  Dim vResult As Variant
+  vResult = word_.Run("RulesAccess.RunRule", sRuleID, bApplyFix)
+  If vResult(0) <> 0 Then _
+    Call Err.Raise(vResult(0))
+  errors_ = vResult(1)
+  fixes_ = vResult(2)
+End Function
+
+Public Function FinalizeProcessing()
+  Call word_.Run("RulesAccess.FinalizeRulesProcessing")
+End Function

src/SelectSourceDlg.frm

@@ -0,0 +1,93 @@
+VERSION 5.00
+Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} SelectSourceDlg 
+   Caption         =   "Äîêóìåíòû Word"
+   ClientHeight    =   4965
+   ClientLeft      =   120
+   ClientTop       =   465
+   ClientWidth     =   4560
+   OleObjectBlob   =   "SelectSourceDlg.frx":0000
+   StartUpPosition =   1  'CenterOwner
+End
+Attribute VB_Name = "SelectSourceDlg"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Public bCanceled As Boolean
+Private m_ExcelDB As Excel.Workbook
+
+Private Sub UserForm_Initialize()
+  bCanceled = True
+  
+  Dim TopOffset&
+  Dim LeftOffset&
+   
+  TopOffset = (Application.UsableHeight / 2) - (Me.Height / 2)
+  LeftOffset = (Application.UsableWidth / 2) - (Me.Width / 2)
+   
+  Me.StartUpPosition = 0
+  Me.Top = Application.Top + TopOffset
+  Me.Left = Application.Left + LeftOffset
+End Sub
+
+Public Function SetSelect(sRes$)
+  Dim nCount&
+  Dim i&
+  nCount = ListBox1.ListCount
+  For i = 0 To nCount - 1
+    ListBox1.Selected(i) = ListBox1.List(i) = sRes
+  Next i
+End Function
+
+Public Function GetSelectedText() As String
+  Dim i&
+  For i = 0 To ListBox1.ListCount - 1
+    If ListBox1.Selected(i) = True Then
+      GetSelectedText = ListBox1.List(i)
+      Exit Function
+    End If
+  Next i
+End Function
+
+Public Function GetSelectedID() As Long
+  Dim i&
+  For i = 0 To ListBox1.ListCount - 1
+    If ListBox1.Selected(i) = True Then
+      GetSelectedID = i + 1
+      Exit Function
+    End If
+  Next i
+End Function
+
+
+Public Function Init(nameList As Collection)
+  bCanceled = True
+  
+  ListBox1.Clear
+  Dim i&
+  Dim aText$
+  For i = 1 To nameList.Count
+    aText = nameList.Item(i)
+    Call ListBox1.AddItem(aText)
+  Next i
+End Function
+
+Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
+  Call OkBtn_Click
+End Sub
+
+Private Sub SelectSource_Activate()
+  bCanceled = True
+End Sub
+
+Private Sub OkBtn_Click()
+  bCanceled = False
+  Me.Hide
+End Sub
+
+Private Sub CancelBtn_Click()
+  bCanceled = True
+  Me.Hide
+End Sub

src/UIState.cls

@@ -0,0 +1,148 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "UIState"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+Private controlData_ As Excel.Worksheet
+
+Private Sub Class_Initialize()
+  Set controlData_ = ThisWorkbook.Sheets(SHEET_UI)
+End Sub
+
+Public Function InputTargetFile()
+  Call UpdateFileInCell(ThisWorkbook.Names(CELL_TARGET_PATH).RefersToRange)
+End Function
+
+Public Function InputTemplate()
+  Call UpdateFileInCell(ThisWorkbook.Names(STYLE_TEMPLATE_NAME).RefersToRange)
+End Function
+
+Public Function ProduceRulesConfig() As API_Config
+  Dim result As New API_Config
+  Call result.SetValue("HighlightErrors", HighlightErrors)
+  Call result.SetValue("CommentUnresolved", CommentUnresolved)
+  Call result.SetValue("BannedWords", LoadBannedWords)
+  Set ProduceRulesConfig = result
+End Function
+
+Public Function ChooseTargetFileFromOpened()
+  ' Çàïðàâøèâàåì àíàëèçèðóåìûé èç ñïèñêà îòêðûòûõ
+  On Error GoTo NO_APPLICATION
+  Dim wordAppl As Word.Application: Set wordAppl = GetObject(, "Word.Application")
+  
+  Dim fileList As New Collection
+  Dim nameList As New Collection
+  Dim i&
+  For i = 1 To wordAppl.Documents.Count
+    Call fileList.Add(wordAppl.Documents.Item(i).FullName)
+    Call nameList.Add(wordAppl.Documents.Item(i).Name)
+  Next
+  
+  Call SelectSourceDlg.Init(nameList)
+  SelectSourceDlg.Show
+  If SelectSourceDlg.bCanceled Then _
+    Exit Function
+    
+  ThisWorkbook.Names(CELL_TARGET_PATH).RefersToRange = fileList(SelectSourceDlg.GetSelectedID)
+  
+  Exit Function
+  
+NO_APPLICATION:
+  Call UserInteraction.ShowMessage(EM_NO_OPEN_DOCS)
+End Function
+
+Public Function LogStylesData(nCount&, renames&, deletes&)
+' Çàïîëíÿåì äàííûå àíàëèçà ñòèëåé
+  ThisWorkbook.Sheets(SHEET_UI).Range(STYLE_COUNT_NAME) = nCount
+  ThisWorkbook.Sheets(SHEET_UI).Range(STYLE_DELETE_NAME) = deletes
+  ThisWorkbook.Sheets(SHEET_UI).Range(STYLE_RENAME_NAME) = renames
+End Function
+
+' ========= Get ========
+Public Property Get PageCount() As Long
+  PageCount = ThisWorkbook.Names(CELL_PAGE_COUNT).RefersToRange
+End Property
+
+Public Property Get SingleRuleID() As String
+  SingleRuleID = ThisWorkbook.Names(CELL_SINGLE_RULE).RefersToRange
+End Property
+
+Public Property Get ShowDiff() As Boolean
+' ×òåíèå ôëàãà"ñðàâíèòü ïîñëå èñïðàâëåíèÿ"
+  ShowDiff = ThisWorkbook.Sheets(SHEET_UI).OptionDiff.Value
+End Property
+
+Public Property Get RevisionEnabled() As Boolean
+' ×òåíèå ôëàãà "èñïðàâëÿòü â ðåæèìå ðåöåíçèðîâàíèÿ"
+  RevisionEnabled = ThisWorkbook.Sheets(SHEET_UI).OptionRevision.Value
+End Property
+
+Public Property Get CommentUnresolved() As Boolean
+' ×òåíèå ôëàãà "äîáàâëÿòü êîììåíòàðèè ê íåèñïðàâëåííûì îøèáêàì"
+  CommentUnresolved = ThisWorkbook.Sheets(SHEET_UI).DoAddComment.Value
+End Property
+
+Public Property Get HighlightErrors() As Boolean
+' ×òåíèå ôëàãà "âûäåëÿòü öâåòîì íåèñïðàâëåííûå îøèáêè"
+  HighlightErrors = ThisWorkbook.Sheets(SHEET_UI).DoHighlightCB.Value
+End Property
+
+Public Property Get DoDebug() As Boolean
+  DoDebug = ThisWorkbook.Sheets(SHEET_UI).TurnOnDebug.Value
+End Property
+
+Public Property Get StylesDeleteUnused() As Boolean
+  StylesDeleteUnused = ThisWorkbook.Sheets(SHEET_UI).DoDeleteUnused.Value
+End Property
+
+Public Property Get StylesRename() As Boolean
+  StylesRename = ThisWorkbook.Sheets(SHEET_UI).DoRenameStyles.Value
+End Property
+
+Public Property Get StylesFormat() As Boolean
+  StylesFormat = ThisWorkbook.Sheets(SHEET_UI).DoFormatStyles.Value
+End Property
+
+Public Property Get ErrorsCount() As Long
+  Dim iCell As Excel.Range: Set iCell = ThisWorkbook.Names(CELL_ERROR_COUNT).RefersToRange
+  Call iCell.Calculate
+  ErrorsCount = iCell
+End Property
+
+Public Property Get FixesCount() As Long
+  Dim iCell As Excel.Range: Set iCell = ThisWorkbook.Names(CELL_FIXES_COUNT).RefersToRange
+  Call iCell.Calculate
+  FixesCount = iCell
+End Property
+
+Public Property Get TargetPath() As String
+  TargetPath = ThisWorkbook.Names(CELL_TARGET_PATH).RefersToRange
+End Property
+
+Public Property Get TemplatePath() As String
+  Dim result$
+  result = ThisWorkbook.Sheets(SHEET_UI).Range(STYLE_TEMPLATE_NAME)
+  If VBA.Left(result, 9) Like "%APPDATA%" Then
+    result = Environ("appdata") & VBA.Right(result, VBA.Len(result) - 9)
+  End If
+  TemplatePath = result
+End Property
+
+' ========= Let ========
+Public Property Let PageCount(newVal&)
+  ThisWorkbook.Names(CELL_PAGE_COUNT).RefersToRange = newVal
+End Property
+
+' ======
+Private Function UpdateFileInCell(aCell As Excel.Range)
+  Dim result$: result = UserInteraction.PromptFile(aCell.Text)
+  If Not result = "" Then
+    aCell = result
+  End If
+End Function

src/z_UIMessages.bas

@@ -0,0 +1,96 @@
+Attribute VB_Name = "z_UIMessages"
+' Ìîäóëü âûâîäà ñîîáùåíèé è âçàèìîäåéñòâèÿ ñ ïîëüçîâàòåëåì
+Option Private Module
+Option Explicit
+
+'# Êîäû ñîîáùåíèé
+Public Enum MsgCode
+  MSG_OK = 0
+  
+  EM_DOC_READONLY
+  EM_RULE_FAILED
+  EM_NO_OPEN_DOCS
+  EM_PATH_EMPTY
+  EM_MISSING_FILE
+  
+  IM_RULES_COMPLETE
+  IM_STYLES_FIXED
+  IM_FORMAT_CLEARED
+  IM_UPDATE_BANNED_FAIL
+  IM_UPDATE_BANNED_SUCCESS
+  
+  QM_SAVE_DOC
+  QM_WARN_COMMENTS
+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)
+  
+  Select Case Err.Number
+'    Case EM_LINK_NO_FILE: Call UserInteraction.ShowMessage(Err.Number, Err.Source)
+  End Select
+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_DOC_READONLY
+    Call MsgBox("Ôàéë îòêðûò â ðåæèìå ÷òåíèÿ!" & vbNewLine & "Ïîæàëóéñòà, ñîõðàíèòå ôàéë â ðåæèìå ðåäàêòèðîâàíèÿ", vbExclamation)
+  Case EM_RULE_FAILED
+    Call MsgBox(Fmt("Ïðàâèëî {1} áûëî çàâåðøåíî ñ îøèáêîé! Ïîæàëóéñòà, ïðîèíôîðìèðóéòå ðàçðàáîò÷èêà", unwrapped), vbExclamation)
+  Case EM_NO_OPEN_DOCS:         Call MsgBox("Îòñóòñòâóþò îòêðûòûå äîêóìåíòû Word", vbExclamation)
+  Case EM_PATH_EMPTY:           Call MsgBox("Ïóòü ê ôàéëó íå óêàçàí!", vbExclamation)
+  Case EM_MISSING_FILE:         Call MsgBox(Fmt("Îòñóòñòâóåò äîñòóï ê ôàéëó: {1}", unwrapped), vbExclamation)
+    
+  Case IM_RULES_COMPLETE
+    Call MsgBox(Fmt("Âðåìÿ âûïîëíåíèÿ: {1} ms" & vbNewLine & vbNewLine & _
+                    "Íàéäåíî îøèáîê: {2}" & vbNewLine & _
+                    "Âíåñåíî ïðàâîê: {3}", unwrapped), vbInformation)
+  Case IM_STYLES_FIXED:         Call MsgBox("Ïðîâåðêà ñòèëåé ïðîøëà óñïåøíî!", vbInformation)
+  Case IM_FORMAT_CLEARED:       Call MsgBox("Î÷èñòêà çàâåðøåíà", vbInformation)
+  Case IM_UPDATE_BANNED_SUCCESS: Call MsgBox("Îáíîâëåíèå ëîêàëüíîãî ñïèñêà óñïåøíî", vbInformation)
+  Case IM_UPDATE_BANNED_FAIL:   Call MsgBox("Îáíîâëåíèå íå ïðîøëî. Ïðîâåðüòå ïîäêëþ÷åíèå ê \\fs1.concept.ru", 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 As Long: answer = vbNo
+  Select Case theCode
+  Case QM_SAVE_DOC
+    answer = MsgBox("Âíèìàíèå!! Ïðè ïðîâåðêå äîêóìåíòà â ñëó÷àå ñáîÿ âîçìîæíà ïîòåðÿ äàííûõ." & vbNewLine _
+                    & "Âû õîòèòå ñîõðàíèòü äîêóìåíò ïåðåä ïðîâåðêîé?", vbYesNo + vbQuestion)
+                    
+  Case QM_WARN_COMMENTS
+    answer = MsgBox("Âíèìàíèå!! Îáíàðóæåíû êîììåíòàðèè â äîêóìåíòå. Ýòî ìîæåò ïðèâåñòè ê ñáîþ ïðîãðàììû." & vbNewLine _
+            & "Êîììåíòàðèè áóäóò óäàëåíû, Âû õîòèòå ïðîäîëæèòü?", vbYesNo + vbQuestion, "Çàïóñê ïðîâåðêè")
+    
+  Case Else
+    Call MsgBox("Íåâåðíûé êîä ñîîáùåíèÿ", vbCritical)
+  End Select
+  UIAskQuestion = answer = vbYes
+End Function

src/z_UIRibbon.bas

@@ -0,0 +1,30 @@
+Attribute VB_Name = "z_UIRibbon"
+Option Private Module
+Option Explicit
+
+Public Function AccessUI() As UIState
+  Static s_State As UIState
+  If s_State Is Nothing Then _
+    Set s_State = New UIState
+  Set AccessUI = s_State
+End Function
+
+Public Sub OnRibbonBtn(iControl As IRibbonControl)
+  Select Case iControl.ID
+  Case "InputFile":           Call RunInputFile
+  Case "InputOpen":           Call RunInputOpen
+  Case "OpenTarget":          Call RunOpenTarget
+  Case "InputTemplate":       Call RunInputTemplate
+  
+  Case "Checkup":             Call RunCheckup
+  Case "FixErrors":           Call RunFixErrors
+  Case "FixStyles":           Call RunFixStyles
+  Case "FixManualFormat":     Call RunFixManualFormat
+  
+  Case "ChooseRules":         Call RunChooseRules
+  Case "AskHelp":             Call RunHelp
+  
+  Case "Recovery":            Call RunRecovery
+  
+  End Select
+End Sub

ui/.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/customUI.xml

@@ -0,0 +1,75 @@
+<?xml version="1.0" encoding="utf-8"?>
+<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" >
+	<ribbon>
+	<tabs>
+	<tab id="MasterText" label="МАСТЕР">
+	<group id="Input" label="Входы">
+		<button id="InputFile" size="large" 
+			label="Выбрать файл"
+			supertip="Выбрать целевой файл" 
+			imageMso="BrowseToAttach"
+			onAction="OnRibbonBtn"/>
+		<button id="InputOpen" size="large" 
+			label="Выбрать открытый"
+			supertip="Выбрать целевой файл из открытых в Word" 
+			imageMso="FileCompatibilityCheckerWord"
+			onAction="OnRibbonBtn"/>
+		<button id="OpenTarget" size="large" 
+			label="Word"
+			supertip="Открыть целевой файл в Word" 
+			imageMso="FileSaveAsWordDocx"
+			onAction="OnRibbonBtn"/>
+		<button id="InputTemplate" size="large" 
+			label="Шаблон стилей"
+			supertip="Задать шаблон со стилями для сравнения с входным файлом" 
+			imageMso="GroupTemplates"
+			onAction="OnRibbonBtn"/>
+	</group>
+	
+	<group id="Actions" label="Действия">
+		<button id="Checkup" size="large" 
+			label="Проверить"
+			supertip="Выделить проблемы в текущем документе" 
+			imageMso="UpdateBibliography"
+			onAction="OnRibbonBtn"/>
+		<button id="FixErrors" size="large" 
+			label="Исправить ошибки"
+			supertip="Исправить проблемы в текущем документе" 
+			imageMso="TouchTriageFollowUp_Completed"
+			onAction="OnRibbonBtn"/>
+		<button id="FixStyles" size="large" 
+			label="Исправить стили"
+			supertip="Исправить стили, не соответствующие шаблону" 
+			imageMso="ApplyStylesPane"
+			onAction="OnRibbonBtn"/>
+		<button id="FixManualFormat" size="large" 
+			label="Ручной формат"
+			supertip="Удалить ручное форматирование" 
+			imageMso="ClearAll"
+			onAction="OnRibbonBtn"/>
+	</group>
+	
+	<group id="Options" label="Настройки">
+		<button id="ChooseRules" size="large" 
+			label="Правила"
+			supertip="Выбрать список активных правил" 
+			imageMso="BulletListDefault"
+			onAction="OnRibbonBtn"/>
+		<button id="AskHelp" visible="true" size="large" 
+			label="Справка"
+			supertip="Вызов справки" 
+			imageMso="Info"
+			onAction="OnRibbonBtn"/>
+	</group>
+	
+	<group id="Debug" label="Отладка">
+		<button id="Recovery" size="large" 
+			label="Восстановить"
+			supertip="Восстановить интерфейс после неудачного запуска проверки" 
+			imageMso="ConnectedToolSyncMenu"
+			onAction="OnRibbonBtn"/>
+	</group>
+	</tab>
+	</tabs>
+	</ribbon>
+</customUI>