Initial commit
This commit is contained in:
commit
a729cc4b83
38
VBAMake.txt
Normal file
38
VBAMake.txt
Normal 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
|
BIN
distr/!!Листовка.docx
Normal file
BIN
distr/!!Листовка.docx
Normal file
Binary file not shown.
BIN
distr/!Руководство пользователя.docx
Normal file
BIN
distr/!Руководство пользователя.docx
Normal file
Binary file not shown.
125
distr/banned-words.txt
Normal file
125
distr/banned-words.txt
Normal file
|
@ -0,0 +1,125 @@
|
|||
никогда
|
||||
нигде
|
||||
эффективность
|
||||
эффективности
|
||||
эффективностью
|
||||
минимальный
|
||||
минимального
|
||||
минимальная
|
||||
минимальной
|
||||
минимальному
|
||||
минимальным
|
||||
минимальные
|
||||
минимальными
|
||||
минимальному
|
||||
максимальный
|
||||
максимальная
|
||||
максимальные
|
||||
максимальным
|
||||
максимальному
|
||||
максимальной
|
||||
максимальными
|
||||
минимизация
|
||||
минимизации
|
||||
минимизацией
|
||||
глобальный
|
||||
глобальная
|
||||
глобальные
|
||||
глобальным
|
||||
глобальной
|
||||
глобальными
|
||||
глобальному
|
||||
беспрецедентный
|
||||
беспрецедентная
|
||||
беспрецедентные
|
||||
беспрецедентным
|
||||
беспрецедентному
|
||||
беспрецедентными
|
||||
беспрецедентной
|
||||
предельный
|
||||
предельная
|
||||
предельные
|
||||
предельным
|
||||
предельному
|
||||
предельной
|
||||
предельными
|
||||
уникальный
|
||||
уникальная
|
||||
уникальные
|
||||
уникальным
|
||||
уникальными
|
||||
уникальному
|
||||
уникальной
|
||||
реальный
|
||||
реальная
|
||||
реальные
|
||||
реальным
|
||||
реальными
|
||||
реальному
|
||||
реальной
|
||||
всегда
|
||||
подавляющий
|
||||
подавляющего
|
||||
подавляющим
|
||||
подавляющему
|
||||
подавляющем
|
||||
подавляющая
|
||||
подавляющей
|
||||
подавляющие
|
||||
подавляющим
|
||||
подавляющих
|
||||
было
|
||||
был
|
||||
была
|
||||
были
|
||||
эффективный
|
||||
эффективная
|
||||
эффективное
|
||||
эффективные
|
||||
эффективным
|
||||
эффективной
|
||||
эффективными
|
||||
эффективных
|
||||
эффективному
|
||||
эффективном
|
||||
неэффективный
|
||||
неэффективная
|
||||
неэффективное
|
||||
неэффективные
|
||||
неэффективным
|
||||
неэффективной
|
||||
неэффективными
|
||||
неэффективных
|
||||
неэффективному
|
||||
неэффективном
|
||||
минимально
|
||||
максимально
|
||||
эффективно
|
||||
недавно
|
||||
существует
|
||||
существуют
|
||||
существовать
|
||||
текущий
|
||||
текущая
|
||||
текущие
|
||||
текущему
|
||||
текущей
|
||||
текущим
|
||||
текущими
|
||||
текущих
|
||||
постоянно
|
||||
очевидно
|
||||
просто
|
||||
сразу
|
||||
любой бред
|
||||
любого бреда
|
||||
любому бреду
|
||||
любым бредом
|
||||
любом бреде
|
||||
какой-то
|
||||
какая-то
|
||||
какие-то
|
||||
какому-то
|
||||
какой-то
|
||||
каким-то
|
||||
какими-то
|
83
script/masterManifest.txt
Normal file
83
script/masterManifest.txt
Normal 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
|
BIN
skeleton/Мастер текстов.xlsm
Normal file
BIN
skeleton/Мастер текстов.xlsm
Normal file
Binary file not shown.
54
src/DB_Rules.cls
Normal file
54
src/DB_Rules.cls
Normal 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
68
src/Declarations.bas
Normal 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
21
src/DevHelper.bas
Normal 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
127
src/IteratorRule.cls
Normal 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
264
src/Main.bas
Normal 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
186
src/MainImpl.bas
Normal 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
79
src/RulesDlg.frm
Normal 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
BIN
src/RulesDlg.frx
Normal file
Binary file not shown.
36
src/RulesProcessor.cls
Normal file
36
src/RulesProcessor.cls
Normal 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
93
src/SelectSourceDlg.frm
Normal 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
BIN
src/SelectSourceDlg.frx
Normal file
Binary file not shown.
148
src/UIState.cls
Normal file
148
src/UIState.cls
Normal 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
96
src/z_UIMessages.bas
Normal 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
30
src/z_UIRibbon.bas
Normal 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
2
ui/.rels
Normal 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
75
ui/customUI.xml
Normal 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>
|
Loading…
Reference in New Issue
Block a user