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