Initial commit

This commit is contained in:
IRBorisov 2024-06-07 20:49:50 +03:00
commit a729cc4b83
23 changed files with 1526 additions and 0 deletions

38
VBAMake.txt Normal file
View File

@ -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

1
VERSION Normal file
View File

@ -0,0 +1 @@
1.2.0

Binary file not shown.

125
distr/banned-words.txt Normal file
View File

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

83
script/masterManifest.txt Normal file
View File

@ -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

Binary file not shown.

54
src/DB_Rules.cls Normal file
View File

@ -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

68
src/Declarations.bas Normal file
View File

@ -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

21
src/DevHelper.bas Normal file
View File

@ -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

127
src/IteratorRule.cls Normal file
View File

@ -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

264
src/Main.bas Normal file
View File

@ -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

186
src/MainImpl.bas Normal file
View File

@ -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

79
src/RulesDlg.frm Normal file
View File

@ -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

BIN
src/RulesDlg.frx Normal file

Binary file not shown.

36
src/RulesProcessor.cls Normal file
View File

@ -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

93
src/SelectSourceDlg.frm Normal file
View File

@ -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

BIN
src/SelectSourceDlg.frx Normal file

Binary file not shown.

148
src/UIState.cls Normal file
View File

@ -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

96
src/z_UIMessages.bas Normal file
View File

@ -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

30
src/z_UIRibbon.bas Normal file
View File

@ -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

2
ui/.rels Normal file
View File

@ -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>

75
ui/customUI.xml Normal file
View File

@ -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>