Initial commit
This commit is contained in:
IRBorisov
commit
04b897656c
41
VBAMake.txt
Normal file
41
VBAMake.txt
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
# == Properties Section ==
|
||||
# configuration properties
|
||||
# use .ini format to define properties
|
||||
# mandatory properties: name, artifact_home, source_home
|
||||
|
||||
id = WordHelper
|
||||
name = WordHelper
|
||||
description = Надстройка КОНЦЕПТ для Word
|
||||
artifact_home = Addins
|
||||
source_home = WordAI
|
||||
install_home = \\fs1.concept.ru\projects\04 Направления деятельности\60 КИВТ\21 Надстройки\WORD
|
||||
|
||||
%%
|
||||
# === Build section ===
|
||||
# Available commands:
|
||||
# build LOCAL_MANIFEST
|
||||
# copy LOCAL_SOURCE -> [LOCAL_ARTIFACT]
|
||||
# save_as LOCAL_ARTIFACT -> LOCAL_ARTIFACT
|
||||
# run LOCAL_SOURCE.bat
|
||||
|
||||
build script\manifest.txt
|
||||
copy distr\Word.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 CONCEPT.dotm
|
||||
install CONCEPT.dotm -> \\fs1.concept.ru\Exchange\ConceptDistr\data\Add-ins\Word\CONCEPT.dotm
|
||||
|
||||
install Word.docx
|
||||
install Word.docx -> \\fs1.concept.ru\projects\10 Автоматизация деятельности\02 Офисная автоматизация\!Надстройки\Word.docx
|
||||
|
||||
install banned-words.txt
|
||||
install banned-words.txt -> \\fs1.concept.ru\Exchange\ConceptDistr\models\banned-words.txt
|
||||
install banned-words.txt -> \\fs1.concept.ru\projects\10 Автоматизация деятельности\!Concept\models\banned-words.txt
|
||||
BIN
distr/Word.docx
Normal file
BIN
distr/Word.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 @@
|
|||
никогда
|
||||
нигде
|
||||
эффективность
|
||||
эффективности
|
||||
эффективностью
|
||||
минимальный
|
||||
минимального
|
||||
минимальная
|
||||
минимальной
|
||||
минимальному
|
||||
минимальным
|
||||
минимальные
|
||||
минимальными
|
||||
минимальному
|
||||
максимальный
|
||||
максимальная
|
||||
максимальные
|
||||
максимальным
|
||||
максимальному
|
||||
максимальной
|
||||
максимальными
|
||||
минимизация
|
||||
минимизации
|
||||
минимизацией
|
||||
глобальный
|
||||
глобальная
|
||||
глобальные
|
||||
глобальным
|
||||
глобальной
|
||||
глобальными
|
||||
глобальному
|
||||
беспрецедентный
|
||||
беспрецедентная
|
||||
беспрецедентные
|
||||
беспрецедентным
|
||||
беспрецедентному
|
||||
беспрецедентными
|
||||
беспрецедентной
|
||||
предельный
|
||||
предельная
|
||||
предельные
|
||||
предельным
|
||||
предельному
|
||||
предельной
|
||||
предельными
|
||||
уникальный
|
||||
уникальная
|
||||
уникальные
|
||||
уникальным
|
||||
уникальными
|
||||
уникальному
|
||||
уникальной
|
||||
реальный
|
||||
реальная
|
||||
реальные
|
||||
реальным
|
||||
реальными
|
||||
реальному
|
||||
реальной
|
||||
всегда
|
||||
подавляющий
|
||||
подавляющего
|
||||
подавляющим
|
||||
подавляющему
|
||||
подавляющем
|
||||
подавляющая
|
||||
подавляющей
|
||||
подавляющие
|
||||
подавляющим
|
||||
подавляющих
|
||||
было
|
||||
был
|
||||
была
|
||||
были
|
||||
эффективный
|
||||
эффективная
|
||||
эффективное
|
||||
эффективные
|
||||
эффективным
|
||||
эффективной
|
||||
эффективными
|
||||
эффективных
|
||||
эффективному
|
||||
эффективном
|
||||
неэффективный
|
||||
неэффективная
|
||||
неэффективное
|
||||
неэффективные
|
||||
неэффективным
|
||||
неэффективной
|
||||
неэффективными
|
||||
неэффективных
|
||||
неэффективному
|
||||
неэффективном
|
||||
минимально
|
||||
максимально
|
||||
эффективно
|
||||
недавно
|
||||
существует
|
||||
существуют
|
||||
существовать
|
||||
текущий
|
||||
текущая
|
||||
текущие
|
||||
текущему
|
||||
текущей
|
||||
текущим
|
||||
текущими
|
||||
текущих
|
||||
постоянно
|
||||
очевидно
|
||||
просто
|
||||
сразу
|
||||
любой бред
|
||||
любого бреда
|
||||
любому бреду
|
||||
любым бредом
|
||||
любом бреде
|
||||
какой-то
|
||||
какая-то
|
||||
какие-то
|
||||
какому-то
|
||||
какой-то
|
||||
каким-то
|
||||
какими-то
|
||||
87
script/manifest.txt
Normal file
87
script/manifest.txt
Normal file
|
|
@ -0,0 +1,87 @@
|
|||
# == Properties Section ==
|
||||
# configuration properties
|
||||
# use .ini format to define properties
|
||||
# mandatory properties: name, artifact
|
||||
|
||||
name = CONCEPT.dotm
|
||||
artifact = CONCEPT.dotm
|
||||
|
||||
%%
|
||||
# === Imports Section ===
|
||||
# Hierarchy of folders and files
|
||||
# Use Tabulator to mark next level in hierarchy
|
||||
# All folders are nested into SharedHome path
|
||||
|
||||
dev
|
||||
DevTester.bas
|
||||
|
||||
api
|
||||
ex_WinAPI.bas
|
||||
API_WordWrapper.cls
|
||||
API_XLWrapper.cls
|
||||
API_UserInteraction.cls
|
||||
|
||||
word
|
||||
ex_Word.bas
|
||||
API_WordEditGuard.cls
|
||||
|
||||
utility
|
||||
ex_VBA.bas
|
||||
ex_Version.bas
|
||||
|
||||
API_DistrManifest.cls
|
||||
API_Config.cls
|
||||
API_JSON.cls
|
||||
|
||||
ui
|
||||
CSE_ProgressBar.frm
|
||||
|
||||
%%
|
||||
# === Source Code Section ==
|
||||
# Hierarchy of folders and files
|
||||
# Use Tabulator to mark next level in hierarchy
|
||||
# All folders are nested into SourceHome path
|
||||
|
||||
src
|
||||
DevHelper.bas
|
||||
Declarations.bas
|
||||
Main.bas
|
||||
MainImpl.bas
|
||||
z_UIMessages.bas
|
||||
z_UIRibbon.bas
|
||||
|
||||
RulesAccess.bas
|
||||
DocumentEditor.cls
|
||||
RulesProcessor.cls
|
||||
BracketItem.cls
|
||||
|
||||
LMUFunctions.bas
|
||||
LinkFunctions.bas
|
||||
LinkMappingUnit.cls
|
||||
LMUItem.cls
|
||||
|
||||
s_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
|
||||
customizations.xml -> word\customizations.xml
|
||||
|
||||
%%
|
||||
# === References Section ===
|
||||
# List dependencies in one of the formats
|
||||
# global : GLOBAL_NAME
|
||||
# guid : {REGISTERED_GUID}
|
||||
# file : PATH_TO_LIBRARY
|
||||
|
||||
global : Shell32
|
||||
global : Scripting
|
||||
global : Excel
|
||||
global : MSForms
|
||||
global : ADODB
|
||||
global : IWshRuntimeLibrary
|
||||
BIN
skeleton/CONCEPT.dotm
Normal file
BIN
skeleton/CONCEPT.dotm
Normal file
Binary file not shown.
14
src/BracketItem.cls
Normal file
14
src/BracketItem.cls
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "BracketItem"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
' ====== Êëàññ ýëåìåíòà ñòåêà ñêîáîê =====
|
||||
|
||||
Public brType As BracketType ' Òèï ñêîáêè: êðóãëàÿ, êâàäðàòíàÿ, ôèãóðíàÿ
|
||||
Public brRange As Word.Range ' Ïðèâÿçêà ñêîáêè ê òåêñòó
|
||||
Public brMark As Boolean ' Ôëàã äëÿ ïðîõîäà ïî ýëåìåíòàì ñòåêà
|
||||
36
src/Declarations.bas
Normal file
36
src/Declarations.bas
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
Attribute VB_Name = "Declarations"
|
||||
Option Explicit
|
||||
|
||||
Public Const CONCEPT_SERVER_HOME = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\!Concept\"
|
||||
Public Const CONCEPT_LOCAL_HOME = ".concept\"
|
||||
Public Const CONCEPT_BANNED_WORDS = "banned-words.txt"
|
||||
Public Const CONCEPT_MASTER_CONFIG = "master-config.json"
|
||||
|
||||
Public Const SERVER_PATH_HELP = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\02 Îôèñíàÿ àâòîìàòèçàöèÿ\!Íàäñòðîéêè\Word.docx"
|
||||
Public Const SERVER_MASTER_TEXT = "\\fs1.concept.ru\projects\10 Àâòîìàòèçàöèÿ äåÿòåëüíîñòè\01 Âûñîêèå òåõíîëîãèè\ÂÒ-04 Ìàñòåð òåêñòîâ\Ìàñòåð òåêñòîâ.xlsm"
|
||||
|
||||
Public Const SERVER_ADDIN_EXCEL = "\\fs1.concept.ru\Data\Add-ins\Excel"
|
||||
|
||||
Public Const ADDIN_NAME_CONCEPT = "CONCEPT.xlam"
|
||||
Public Const ADDIN_NAME_REPORT = "ConceptReport.xlam"
|
||||
|
||||
Public Const CELL_MASTER_PATH = "c_DocPath"
|
||||
|
||||
Public Const PAR_SCALE_MAX = 0.25
|
||||
Public Const PAR_SCALE_STEP = 0.1
|
||||
|
||||
Public Enum BracketType
|
||||
BT_PAP = 0
|
||||
BT_SQU = 1
|
||||
BT_FIG = 2
|
||||
End Enum
|
||||
|
||||
Public Function GetBracketType(sChr$) As BracketType
|
||||
' ----- Îïðåäåëåíèå òèïà ñêîáîê ----------
|
||||
Dim rndB$: rndB = "[\(\)]"
|
||||
'Dim sqrB$: sqrB = "[" & "]"
|
||||
Dim figB$: figB = "[\{\}]"
|
||||
GetBracketType = BT_SQU
|
||||
If sChr Like rndB Then GetBracketType = BT_PAP
|
||||
If sChr Like figB Then GetBracketType = BT_FIG
|
||||
End Function
|
||||
20
src/DevHelper.bas
Normal file
20
src/DevHelper.bas
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
Attribute VB_Name = "DevHelper"
|
||||
Option Explicit
|
||||
|
||||
Public Function Dev_PrepareSkeleton()
|
||||
ThisDocument.Range.Text = vbNullString
|
||||
End Function
|
||||
|
||||
Public Sub ADev_ManualRunTest()
|
||||
Dim sSuite$: sSuite = "s_RulesProcessor"
|
||||
Dim sTest$: sTest = "t_Quotes"
|
||||
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_RulesProcessor": Set Dev_GetTestSuite = New s_RulesProcessor
|
||||
End Select
|
||||
End Function
|
||||
221
src/DocumentEditor.cls
Normal file
221
src/DocumentEditor.cls
Normal file
|
|
@ -0,0 +1,221 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "DocumentEditor"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Const ERROR_HIGHLIGHT_COLOR = wdViolet
|
||||
Private Const COMMENT_PREFIX_BM = "zCOMMENT_TMP_"
|
||||
|
||||
Private document_ As Word.Document
|
||||
Private highlightErrors_ As Boolean
|
||||
Private commentUnresolved_ As Boolean
|
||||
|
||||
Private comments_ As Scripting.Dictionary
|
||||
|
||||
Public Function Init(target As Word.Document, iConfig As API_Config)
|
||||
Set document_ = target
|
||||
Set comments_ = New Scripting.Dictionary
|
||||
highlightErrors_ = iConfig.GetValue("HighlightErrors", False)
|
||||
commentUnresolved_ = iConfig.GetValue("CommentUnresolved", True)
|
||||
End Function
|
||||
|
||||
Public Property Get Document() As Word.Document
|
||||
Set Document = document_
|
||||
End Property
|
||||
|
||||
Public Function MarkError(target As Word.Range, sComment$)
|
||||
' Îòìå÷àåì îøèáêó
|
||||
If highlightErrors_ Then _
|
||||
Call FormatRange(target)
|
||||
If commentUnresolved_ Then _
|
||||
Call AddCommentToRange(target, sComment)
|
||||
End Function
|
||||
|
||||
Public Function FormatRange(target As Word.Range)
|
||||
' Âûäåëÿåì íàéäåííóþ îøèáêó
|
||||
Dim tmpRevision As Boolean: tmpRevision = document_.TrackRevisions
|
||||
document_.TrackRevisions = False
|
||||
target.HighlightColorIndex = ERROR_HIGHLIGHT_COLOR
|
||||
document_.TrackRevisions = tmpRevision
|
||||
End Function
|
||||
|
||||
Public Function AddBookmark(target As Word.Range, sPrefix$) As String
|
||||
Dim nIndex&: nIndex = document_.Bookmarks.Count + 1
|
||||
Dim sBookmark$: sBookmark = sPrefix & nIndex
|
||||
Do While document_.Bookmarks.Exists(sBookmark)
|
||||
nIndex = nIndex - 1
|
||||
sBookmark = sPrefix & nIndex
|
||||
Loop
|
||||
|
||||
AddBookmark = sBookmark
|
||||
If target.Bookmarks.Add(sBookmark, target) Is Nothing Then _
|
||||
Call Err.Raise(vbObjectError)
|
||||
End Function
|
||||
|
||||
Public Function AddCommentToRange(target As Word.Range, sComment$)
|
||||
' Äîáàâëÿåì êîììåíòàðèé (çàïîìèíàåì, ÷òî íóæíî äîáàâèòü)
|
||||
Dim sBookmark$: sBookmark = AddBookmark(target, COMMENT_PREFIX_BM)
|
||||
If sBookmark = vbNullString Then _
|
||||
Exit Function
|
||||
Call comments_.Add(sBookmark, sComment)
|
||||
End Function
|
||||
|
||||
Public Function AddGlobalComment(sComment$)
|
||||
' Äîáàâëÿåì â äîêóìåíò êîììåíòàðèé ê ïåðâîìó àáçàöó
|
||||
Dim iRange As Word.Range: Set iRange = document_.Paragraphs(1).Range
|
||||
If iRange.Comments.Count = 0 Then _
|
||||
Call iRange.Comments.Add(iRange)
|
||||
|
||||
Dim theBM As Word.Comment: Set theBM = iRange.Comments(1)
|
||||
If theBM.Range.Text = vbNullString Then
|
||||
theBM.Range.Text = sComment
|
||||
Else
|
||||
theBM.Range.Text = theBM.Range.Text & vbNewLine & sComment
|
||||
End If
|
||||
End Function
|
||||
|
||||
Public Function SetupFindLiteral(sSearch$) As Word.Range
|
||||
Dim rFind As Word.Range: Set rFind = document_.Range
|
||||
rFind.Find.ClearFormatting
|
||||
With rFind.Find
|
||||
.Text = sSearch
|
||||
.Format = True
|
||||
.Font.Hidden = False
|
||||
.MatchWildcards = False
|
||||
.Forward = True
|
||||
End With
|
||||
Set SetupFindLiteral = rFind
|
||||
End Function
|
||||
|
||||
Public Function SetupFindWildcard(sSearch$) As Word.Range
|
||||
Dim rFind As Word.Range: Set rFind = document_.Range
|
||||
rFind.Find.ClearFormatting
|
||||
With rFind.Find
|
||||
.Text = sSearch
|
||||
.Format = True
|
||||
.Font.Hidden = False
|
||||
.MatchWildcards = True
|
||||
.Forward = True
|
||||
End With
|
||||
Set SetupFindWildcard = rFind
|
||||
End Function
|
||||
|
||||
Public Function ReplaceText(sFind$, sReplacement$, bApplyFix As Boolean, Optional sComment$ = vbNullString) As Long
|
||||
ReplaceText = FindAndReplace(sFind, sReplacement, bApplyFix, sComment, _
|
||||
bCase:=False, bWildcard:=False, bWhole:=True)
|
||||
End Function
|
||||
|
||||
Public Function ReplaceWC(sFind$, sReplacement$, bApplyFix As Boolean, Optional sComment$ = vbNullString) As Long
|
||||
ReplaceWC = FindAndReplace(sFind, sReplacement, bApplyFix, sComment, _
|
||||
bCase:=False, bWildcard:=True, bWhole:=False)
|
||||
End Function
|
||||
|
||||
Public Function FindAndReplace(sFind$, sReplacement$, _
|
||||
bApplyFix As Boolean, Optional sComment$ = vbNullString, _
|
||||
Optional bCase As Boolean = False, _
|
||||
Optional bWildcard As Boolean = False, _
|
||||
Optional bWhole As Boolean = True) As Long
|
||||
' Îñóùåñòâëÿåì ïîäñòàíîâêè â ôàéëå è ñ÷èòàåì èõ ÷èñëî
|
||||
Dim result&: result = 0
|
||||
Dim rFind As Word.Range: Set rFind = document_.Range
|
||||
With rFind.Find
|
||||
.Text = sFind
|
||||
.Replacement.Text = IIf(bApplyFix, sReplacement, "")
|
||||
.Format = True
|
||||
.Font.Hidden = False
|
||||
.MatchCase = bCase
|
||||
.MatchWholeWord = bWhole
|
||||
.MatchWildcards = bWildcard
|
||||
.Forward = True
|
||||
End With
|
||||
|
||||
Do While rFind.Find.Execute(Replace:=1 * bApplyFix)
|
||||
result = result + 1
|
||||
If Not bApplyFix Then _
|
||||
Call MarkError(rFind, sComment)
|
||||
Call rFind.Collapse(wdCollapseEnd)
|
||||
Loop
|
||||
|
||||
FindAndReplace = result
|
||||
End Function
|
||||
|
||||
Public Function ReplaceCascade(sFind$, _
|
||||
findText2$, repText2$, bApplyFix As Boolean, _
|
||||
Optional sComment$ = vbNullString, _
|
||||
Optional bCase As Boolean = False, _
|
||||
Optional bWildcard As Boolean = False, _
|
||||
Optional bWhole As Boolean = False) As Long
|
||||
' Îñóùåñòâëÿåì ïîäñòàíîâêè â ðåæèìå ðåöåíçèðîâàíèÿ ñ ó÷åòîì bWildcard
|
||||
' Ýòî îñîáûé ñëó÷àé, ñâÿçàííûé ñ íåêîððåêòíûìè ïîäñòàíîâêàìè â ðåæèìå ðåöåíçèðîâàíèÿ è èñïîëüçîâàíèÿ "\1"
|
||||
Dim result&: result = 0
|
||||
If repText2 = vbNullString And bApplyFix Then
|
||||
ReplaceCascade = result
|
||||
Debug.Print "Íåêîððåêòíûé àðãóìåíò: ïóñòàÿ ñòðîêà çàìåíû"
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim rFind As Word.Range: Set rFind = document_.Range
|
||||
With rFind.Find
|
||||
.Text = sFind
|
||||
.MatchWildcards = True
|
||||
.Forward = True
|
||||
.Format = True
|
||||
.Font.Hidden = False
|
||||
|
||||
Do While .Execute
|
||||
.Text = findText2
|
||||
.Replacement.Text = repText2
|
||||
.MatchCase = bCase
|
||||
.MatchWholeWord = bWhole
|
||||
.MatchWildcards = bWildcard
|
||||
|
||||
If .Execute(Replace:=1 * bApplyFix) Then
|
||||
result = result + 1
|
||||
If Not bApplyFix Then _
|
||||
Call MarkError(rFind, sComment)
|
||||
End If
|
||||
|
||||
.Text = sFind
|
||||
.Replacement.Text = vbNullString
|
||||
.MatchCase = False
|
||||
.MatchWholeWord = False
|
||||
.MatchWildcards = True
|
||||
|
||||
Call rFind.Collapse(wdCollapseEnd)
|
||||
Loop
|
||||
End With
|
||||
|
||||
ReplaceCascade = result
|
||||
End Function
|
||||
|
||||
Public Function FinalizeComments()
|
||||
' Âñòàâëÿåì âñå êîììåíòàðèè (ïîñëå ïðîâåðêè âñåõ ïðàâèë)
|
||||
On Error Resume Next
|
||||
If document_.Bookmarks.Count = 0 Then _
|
||||
Exit Function
|
||||
|
||||
If CSE_ProgressBar.Visible Then _
|
||||
Call CSE_ProgressBar.Init("", sHeader:="Îòìå÷àåì íàéäåííûå íåñîîòâåòñòâèÿ...", minVal:=0, curVal:=1, maxVal:=comments_.Count)
|
||||
|
||||
Dim target As Word.Range
|
||||
Dim vBookmark As Variant
|
||||
For Each vBookmark In comments_.Keys()
|
||||
If Not document_.Bookmarks.Exists(CStr(vBookmark)) Then _
|
||||
GoTo NEXT_ITEM
|
||||
Set target = document_.Bookmarks(vBookmark).Range
|
||||
Call document_.Bookmarks(vBookmark).Delete
|
||||
Call target.Comments.Add(target, comments_(vBookmark))
|
||||
NEXT_ITEM:
|
||||
If CSE_ProgressBar.Visible Then _
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
Next
|
||||
|
||||
Set comments_ = New Scripting.Dictionary
|
||||
End Function
|
||||
|
||||
26
src/LMUFunctions.bas
Normal file
26
src/LMUFunctions.bas
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
Attribute VB_Name = "LMUFunctions"
|
||||
'===== Ìîäóëü âíåøíèõ ôóíêöèé äëÿ êëàññà ïðîâåðêè ññûëîê =====
|
||||
Option Explicit
|
||||
Option Private Module
|
||||
|
||||
Public Type LMU_LinksInfo
|
||||
lnkCount_ As Long
|
||||
errCount_ As Long
|
||||
modCount_ As Long
|
||||
End Type
|
||||
|
||||
Public Enum LMU_Return
|
||||
RV_LINK_OK
|
||||
RV_LINK_FIXED
|
||||
RV_LINK_NOFIX
|
||||
RV_NOTAFSO
|
||||
End Enum
|
||||
|
||||
Public Function GetLMU() As LinkMappingUnit
|
||||
Static result As LinkMappingUnit ' Ñòàòè÷åñêàÿ ïåðåìåííàÿ
|
||||
If result Is Nothing Then
|
||||
' Îòêðûâàåì êîííåêò ïðè ïåðâîì îáðàùåíèè
|
||||
Set result = New LinkMappingUnit
|
||||
End If
|
||||
Set GetLMU = result
|
||||
End Function
|
||||
20
src/LMUItem.cls
Normal file
20
src/LMUItem.cls
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "LMUItem"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
' ===== Êëàññ ýëåìåíòà ïåðå÷íÿ çàìåí =======
|
||||
Public repWhat As String
|
||||
Public repList As Collection
|
||||
Private i As Integer
|
||||
|
||||
'---------- Event handlers and misc code ----------
|
||||
Private Sub Class_Initialize()
|
||||
' Initializing the object
|
||||
Set repList = New Collection
|
||||
repWhat = vbNullString
|
||||
End Sub
|
||||
60
src/LinkFunctions.bas
Normal file
60
src/LinkFunctions.bas
Normal file
|
|
@ -0,0 +1,60 @@
|
|||
Attribute VB_Name = "LinkFunctions"
|
||||
'============== Ìîäóëü îáðàáîòêè ññûëîê ===============
|
||||
Option Explicit
|
||||
Option Private Module
|
||||
|
||||
Public Function GetFullPath(ByVal addr$, docpath$) As String
|
||||
' Ïðåîáðàçîâàíèå îòíîñèòåëüíûõ ïóòåé â àáñîëþòíûå
|
||||
If Left(addr, 1) = "." Or InStr(addr, "\") + InStr(addr, "/") = 0 Then
|
||||
If Not docpath = vbNullString Then
|
||||
addr = docpath & "\" & addr
|
||||
Else
|
||||
GetFullPath = addr
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
|
||||
Dim leftSide$
|
||||
Do While InStr(addr, "../") <> 0
|
||||
leftSide = Left(addr, InStr(addr, "../") - 1)
|
||||
leftSide = Left(leftSide, InStrRev(leftSide, "\", Len(leftSide) - 1))
|
||||
addr = leftSide & Right(addr, Len(addr) - InStr(addr, "../") - 2)
|
||||
Loop
|
||||
|
||||
GetFullPath = Replace(addr, "/", "\")
|
||||
End Function
|
||||
|
||||
Public Function ConvertLinkToLocal(ByVal addr$) As String
|
||||
' Ïðåîáðàçîâàíèå ññûëêè èç P:\ â \\STRG1\...
|
||||
ConvertLinkToLocal = addr
|
||||
If Left(addr, 3) Like "P:\" Then _
|
||||
ConvertLinkToLocal = "\\STRG1\Projects\" & Right(addr, Len(addr) - 3)
|
||||
If Left(addr, 3) Like "X:\" Then _
|
||||
ConvertLinkToLocal = "\\Server\Exchange\" & Right(addr, Len(addr) - 3)
|
||||
End Function
|
||||
|
||||
Public Function ConvertLinkToURL(ByVal addr$) As String
|
||||
' Ïðåîáðàçîâàíèå ññûëêè èç \\STRG1\... â P:\ è \\server\... â X:\
|
||||
ConvertLinkToURL = addr
|
||||
If Left(addr, 17) Like "\\[Ss][Tt][Rr][Gg]1\[Pp]rojects\" Then _
|
||||
ConvertLinkToURL = "P:\" & Right(addr, Len(addr) - 17)
|
||||
If Left(addr, 18) Like "\\[Ss][Ee][Rr][Vv][Ee][Rr]\[Ee]xchange\" Then _
|
||||
ConvertLinkToURL = "X:\" & Right(addr, Len(addr) - 18)
|
||||
End Function
|
||||
|
||||
Public Function SafeGetHLinkAddress(hLink As Hyperlink) As String
|
||||
' Îáðàáàòûâàåì êðèâûå ññûëêè è íå òîëüêî ñì. îøèáêà 4198
|
||||
On Error GoTo PICK_RANGE
|
||||
SafeGetHLinkAddress = hLink.Address
|
||||
|
||||
Exit Function
|
||||
PICK_RANGE:
|
||||
SafeGetHLinkAddress = hLink.Range.Text
|
||||
End Function
|
||||
|
||||
Public Function IsSamePath(ByVal hLinkText$, ByVal hLinkAddress$, docpath$) As Boolean
|
||||
IsSamePath = False
|
||||
hLinkText = UCase(ConvertLinkToURL(GetFullPath(hLinkText, docpath)))
|
||||
hLinkAddress = UCase(ConvertLinkToURL(GetFullPath(hLinkAddress, docpath)))
|
||||
If InStr(hLinkText, hLinkAddress) = 1 And Abs(Len(hLinkText) - Len(hLinkAddress)) <= 1 Then IsSamePath = True
|
||||
End Function
|
||||
128
src/LinkMappingUnit.cls
Normal file
128
src/LinkMappingUnit.cls
Normal file
|
|
@ -0,0 +1,128 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "LinkMappingUnit"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
' Ìîäóëü äëÿ ïðîâåðêè è êîððåêòèðîâêè ññûëîê
|
||||
Option Explicit
|
||||
|
||||
Private m_ReplaceMap As Collection
|
||||
|
||||
'---------- Public Interface ----------
|
||||
Public Function FixLink(ByRef adr$) As LMU_Return
|
||||
' Ïðîâåðêà ññûëîê
|
||||
Dim testAdr$
|
||||
If Not IsFSO(adr, "") Then
|
||||
FixLink = RV_NOTAFSO
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If IsValidAddress(adr) Then
|
||||
testAdr = ConvertLinkToURL(adr)
|
||||
If CheckFile(testAdr, testAdr) Then
|
||||
FixLink = RV_LINK_OK
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
|
||||
testAdr = SwapStrgServer(adr)
|
||||
If CheckFile(testAdr, testAdr) Then
|
||||
FixLink = RV_LINK_FIXED
|
||||
adr = ConvertLinkToLocal(testAdr)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim j&, k&
|
||||
Dim rule As LMUItem
|
||||
Dim result$
|
||||
For j = 1 To m_ReplaceMap.Count
|
||||
Set rule = m_ReplaceMap.Item(j)
|
||||
If InStr(adr, rule.repWhat) = 0 Then _
|
||||
GoTo NEXT_RULE
|
||||
|
||||
For k = 1 To rule.repList.Count
|
||||
result = Replace(testAdr, rule.repWhat, rule.repList(k))
|
||||
If CheckFile(result, "") Then
|
||||
adr = ConvertLinkToLocal(result)
|
||||
FixLink = RV_LINK_FIXED
|
||||
Exit Function
|
||||
End If
|
||||
Next k
|
||||
NEXT_RULE:
|
||||
Next j
|
||||
|
||||
FixLink = RV_LINK_NOFIX
|
||||
End Function
|
||||
|
||||
'---------- Event handlers and misc code ----------
|
||||
Private Sub Class_Initialize()
|
||||
Set m_ReplaceMap = New Collection
|
||||
Dim rule As LMUItem
|
||||
Set rule = New LMUItem
|
||||
rule.repWhat = "01 Income-ïðîåêòû"
|
||||
rule.repList.Add ("00 Àðõèâ\01 Èíêàì")
|
||||
Call m_ReplaceMap.Add(rule)
|
||||
|
||||
Set rule = New LMUItem
|
||||
rule.repWhat = "02 Outcome-ïðîåêòû"
|
||||
rule.repList.Add ("00 Àðõèâ\02 Àóòêàì")
|
||||
Call m_ReplaceMap.Add(rule)
|
||||
|
||||
Set rule = New LMUItem
|
||||
rule.repWhat = "03 Ïåðåãîâîðû Àêòèâíûå"
|
||||
rule.repList.Add ("00 Àðõèâ\03 Ïåðåãîâîðû")
|
||||
rule.repList.Add ("01 Income-ïðîåêòû")
|
||||
rule.repList.Add ("02 Outcome-ïðîåêòû")
|
||||
Call m_ReplaceMap.Add(rule)
|
||||
|
||||
Set rule = New LMUItem
|
||||
rule.repWhat = "031 Ïåðåãîâîðû âîçìîæíûå"
|
||||
rule.repList.Add ("00 Àðõèâ\03 Ïåðåãîâîðû")
|
||||
rule.repList.Add ("03 Ïåðåãîâîðû Àêòèâíûå")
|
||||
Call m_ReplaceMap.Add(rule)
|
||||
|
||||
Set rule = New LMUItem
|
||||
rule.repWhat = "05 ÑÎÓ Êîíöåïò\ÍÒÑ"
|
||||
rule.repList.Add ("05 ÑÎÓ Êîíöåïò\04 ÍÒÑ")
|
||||
Call m_ReplaceMap.Add(rule)
|
||||
End Sub
|
||||
|
||||
Private Function IsValidAddress(ByVal addr$) As Boolean
|
||||
IsValidAddress = True
|
||||
If Left(addr, Len("\\server\Projects")) Like "\\[Ss][Ee][Rr][Vv][Ee][Rr]\[Pp]rojects" Then IsValidAddress = False
|
||||
If Left(addr, Len("\\strg1\Exchange")) Like "\\[Ss][Tt][Rr][Gg]1\[Ee]xchange" Then IsValidAddress = False
|
||||
End Function
|
||||
|
||||
Private Function IsFSO(addr$, docpath$) As Boolean
|
||||
'Ïðîâåðêà ëîêàëüíûõ ññûëîê
|
||||
addr = GetFullPath(addr, docpath)
|
||||
If Left(addr, 3) Like "[PpXx]:\" Then IsFSO = True: Exit Function
|
||||
If Left(addr, 16) Like "\\[Ss][Tt][Rr][Gg]1\[Pp]rojects" Then IsFSO = True: Exit Function
|
||||
If Left(addr, 16) Like "\\[Ss][Tt][Rr][Gg]1\[Ee]xchange" Then IsFSO = True: Exit Function
|
||||
If Left(addr, 17) Like "\\[Ss][Ee][Rr][Vv][Ee][Rr]\[Ee]xchange" Then IsFSO = True: Exit Function
|
||||
If Left(addr, 17) Like "\\[Ss][Ee][Rr][Vv][Ee][Rr]\[Pp]rojects" Then IsFSO = True: Exit Function
|
||||
|
||||
IsFSO = False
|
||||
End Function
|
||||
|
||||
Private Function CheckFile(ByVal addr$, currentPath$) As Boolean
|
||||
' Ïðîâåðêà ñóùåñòâîâàíèÿ ôàéëà
|
||||
If Left(addr, 1) = "." Or InStr(addr, "\") + InStr(addr, "/") = 0 Then _
|
||||
addr = currentPath & "\" & addr
|
||||
|
||||
On Error Resume Next
|
||||
CheckFile = Len(Dir(addr)) <> 0 Or Len(Dir(addr, vbDirectory)) <> 0
|
||||
End Function
|
||||
|
||||
Private Function SwapStrgServer(ByVal addr$)
|
||||
SwapStrgServer = addr
|
||||
If Left(addr, Len("\\server\Projects")) Like "\\[Ss][Ee][Rr][Vv][Ee][Rr]\[Pp]rojects" Then _
|
||||
SwapStrgServer = "P:\" + Right(addr, Len(addr) - Len("\\server\Projects\"))
|
||||
If Left(addr, Len("\\strg1\Exchange")) Like "\\[Ss][Tt][Rr][Gg]1\[Ee]xchange" Then _
|
||||
SwapStrgServer = "X:\" + Right(addr, Len(addr) - Len("\\strg1\Exchange\"))
|
||||
End Function
|
||||
|
||||
354
src/Main.bas
Normal file
354
src/Main.bas
Normal file
|
|
@ -0,0 +1,354 @@
|
|||
Attribute VB_Name = "Main"
|
||||
Option Explicit
|
||||
|
||||
Public Sub CC_AddColumnBreak()
|
||||
Dim selPar As Word.Range: Set selPar = ActiveDocument.ActiveWindow.Selection.Paragraphs.First.Range
|
||||
Call selPar.Collapse(wdCollapseStart)
|
||||
Call selPar.InsertBreak(wdColumnBreak)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_NonBreakPar()
|
||||
ActiveDocument.ActiveWindow.Selection.ParagraphFormat.KeepTogether = Not ActiveDocument.ActiveWindow.Selection.ParagraphFormat.KeepTogether
|
||||
End Sub
|
||||
|
||||
Public Sub CC_WithNext()
|
||||
Selection.ParagraphFormat.KeepWithNext = Not Selection.ParagraphFormat.KeepWithNext
|
||||
End Sub
|
||||
|
||||
Public Sub CC_FieldLowerer()
|
||||
Dim tmpRange As Word.Range: Set tmpRange = ActiveDocument.ActiveWindow.Selection.Range.Duplicate
|
||||
tmpRange.Start = ActiveDocument.ActiveWindow.Selection.Words.First.Start
|
||||
tmpRange.End = ActiveDocument.ActiveWindow.Selection.Words.Last.End
|
||||
|
||||
On Error GoTo EXT_SUB
|
||||
Dim execField As Word.Field
|
||||
For Each execField In tmpRange.Fields
|
||||
Call LowerReference(execField)
|
||||
Next execField
|
||||
EXT_SUB:
|
||||
End Sub
|
||||
|
||||
Public Sub CC_MakeUniqueBM()
|
||||
Dim contextMap As Scripting.Dictionary: Set contextMap = RecreateBookmarks(ActiveDocument)
|
||||
Call FixHyperlinksAfterBMReplace(ActiveDocument, contextMap)
|
||||
Call UserInteraction.ShowMessage(IM_UNIQUE_BOOKMARKS_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_ConvertAllShapesToText()
|
||||
' Ïðâðàùåíèå øåéïîâ â òåêñò
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
Dim tRange As Word.Range: Set tRange = theDoc.Range
|
||||
|
||||
Dim nShape&: nShape = 1
|
||||
Dim theText$
|
||||
|
||||
Dim aShape As Word.Shape
|
||||
Do While nShape <= theDoc.Shapes.Count ' Èòåðàöèÿ ïî íîìåðàì ïîñêîëüêó íóæíî óäàëÿòü ñàìè øåéïû
|
||||
Set aShape = theDoc.Shapes(nShape)
|
||||
If Not aShape.Anchor.InRange(tRange) Then _
|
||||
GoTo NEXT_SHAPE
|
||||
If aShape.Type <> msoTextBox Then _
|
||||
GoTo NEXT_SHAPE
|
||||
|
||||
theText = aShape.TextFrame.TextRange.Text
|
||||
|
||||
aShape.TextFrame.TextRange.Copy
|
||||
tRange.Paragraphs.Add
|
||||
Call tRange.Paragraphs.Last.Range.Paste
|
||||
|
||||
NEXT_SHAPE:
|
||||
nShape = nShape + 1
|
||||
Loop
|
||||
|
||||
Call UserInteraction.ShowMessage(IM_SHAPES_TO_TEXT_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_Convert1252_1251()
|
||||
' Êîíâåðòàöèÿ êîäîâûõ ñòðàíèö
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
theDoc.ActiveWindow.View.ReadingLayout = False
|
||||
|
||||
Dim inputR As Word.Range: Set inputR = theDoc.Application.Selection.Range
|
||||
|
||||
Dim wordUI As New API_WordWrapper: Call wordUI.SetDocument(theDoc)
|
||||
Call wordUI.PauseUI
|
||||
|
||||
Call CSE_ProgressBar.Init("Êîððåêòèðîâêà êîäèðîâêè 1252 -> 1251", sHeader:="Îáðàáîòêà ñèìâîëîâ...", maxVal:=inputR.Characters.Count)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
Dim aChr As Word.Range: Set aChr = inputR.Characters.First
|
||||
Do While aChr.End < inputR.End
|
||||
Dim ChrW&: ChrW = VBA.AscW(aChr)
|
||||
If ChrW < 256 And ChrW > 127 Then _
|
||||
aChr.Text = VBA.Chr(ChrW)
|
||||
Set aChr = aChr.Next(wdCharacter, 1)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
Loop
|
||||
|
||||
Call Unload(CSE_ProgressBar)
|
||||
Call wordUI.ResumeUI
|
||||
Call UserInteraction.ShowMessage(IM_CONVERT_CODEPAGE_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_ParFix()
|
||||
' Modify spacing to make last line optimal length
|
||||
Dim selRange As Word.Range: Set selRange = ActiveDocument.ActiveWindow.Selection.Range.Duplicate
|
||||
Dim aPar As Word.Paragraph
|
||||
For Each aPar In selRange.Paragraphs
|
||||
Dim tRange As Word.Range: Set tRange = aPar.Range
|
||||
If tRange.Tables.Count > 0 Then tRange.End = tRange.End - 1
|
||||
Call tRange.Select
|
||||
Call TryFixingParagraph(tRange)
|
||||
Next aPar
|
||||
End Sub
|
||||
|
||||
Public Sub CC_ExportComments()
|
||||
' Export comments in new document
|
||||
Dim iSource As Word.Document: Set iSource = ActiveDocument
|
||||
Dim iDestination As Word.Document: Set iDestination = Word.Application.Documents.Add
|
||||
|
||||
Dim targetRange As Word.Range: Set targetRange = iDestination.Range
|
||||
Dim aComment As Word.Comment
|
||||
Dim nCount&: nCount = 0
|
||||
Dim nPage&
|
||||
For Each aComment In iSource.Comments
|
||||
nCount = nCount + 1
|
||||
Set targetRange = targetRange.Paragraphs.Add.Range
|
||||
nPage = aComment.Reference.Information(wdActiveEndPageNumber)
|
||||
targetRange.Text = Fmt("Êîììåíòàðèé {1}, ñòðàíèöà {2}, àâòîð {3}:" & vbNewLine & "{4}" & vbNewLine, nCount, nPage, aComment.Author, aComment.Range.Text)
|
||||
Next aComment
|
||||
|
||||
Call UserInteraction.ShowMessage(IM_COMMENT_EXPORT_OK, nCount)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_LineUp()
|
||||
Dim tRange As Word.Range: Set tRange = ActiveDocument.ActiveWindow.Selection.Paragraphs(1).Range
|
||||
Dim iSpace As Double: iSpace = tRange.ParagraphFormat.SpaceBefore + tRange.ParagraphFormat.LineSpacing
|
||||
tRange.ParagraphFormat.SpaceBefore = iSpace
|
||||
End Sub
|
||||
|
||||
Public Sub CC_LineUpA()
|
||||
Dim tRange As Word.Range: Set tRange = ActiveDocument.ActiveWindow.Selection.Paragraphs(1).Range
|
||||
Dim iSpace As Double: iSpace = tRange.ParagraphFormat.SpaceBefore - tRange.ParagraphFormat.LineSpacing
|
||||
tRange.ParagraphFormat.SpaceBefore = IIf(iSpace >= 0, iSpace, 0)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_LineDown()
|
||||
Dim tRange As Word.Range: Set tRange = ActiveDocument.ActiveWindow.Selection.Paragraphs(1).Range
|
||||
Dim iSpace As Double: iSpace = tRange.ParagraphFormat.SpaceAfter + tRange.ParagraphFormat.LineSpacing
|
||||
tRange.ParagraphFormat.SpaceAfter = iSpace
|
||||
End Sub
|
||||
|
||||
Public Sub CC_LineDownA()
|
||||
Dim tRange As Word.Range: Set tRange = ActiveDocument.ActiveWindow.Selection.Paragraphs(1).Range
|
||||
Dim iSpace As Double: iSpace = tRange.ParagraphFormat.SpaceAfter - tRange.ParagraphFormat.LineSpacing
|
||||
tRange.ParagraphFormat.SpaceAfter = IIf(iSpace >= 0, iSpace, 0)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_CheckLinks()
|
||||
' Ïðîâåðêà ãèïåðññûëîê
|
||||
Dim thisDoc As Word.Document: Set thisDoc = ActiveDocument
|
||||
Dim linkCount&: linkCount = thisDoc.Hyperlinks.Count
|
||||
If thisDoc.Hyperlinks.Count = 0 Then
|
||||
Call UserInteraction.ShowMessage(EM_HYPERLINKS_MISSING)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim result As LMU_LinksInfo: result = FixHyperlinksIn(ActiveDocument.Range)
|
||||
Call UserInteraction.ShowMessage(IM_HYPERLINKS_FIX_OK, result.lnkCount_, result.errCount_, result.modCount_)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_AddQuote()
|
||||
ActiveDocument.ActiveWindow.Selection.Range.Text = Chr(171) & ActiveDocument.ActiveWindow.Selection.Text & Chr(187)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_EditCut()
|
||||
' Âûðåçàòü è âñòàâèòü â êîíåö
|
||||
Dim aRange As Word.Range: Set aRange = ActiveDocument.ActiveWindow.Selection.Range
|
||||
aRange.Start = aRange.Paragraphs.First.Range.Start
|
||||
aRange.End = aRange.Paragraphs.Last.Range.End
|
||||
|
||||
Call aRange.Cut
|
||||
Call ActiveDocument.Paragraphs.Add
|
||||
Call ActiveDocument.Paragraphs.Last.Range.Paste
|
||||
End Sub
|
||||
|
||||
Public Sub CC_EditCopy()
|
||||
' Êîïèðîâàòü è âñòàâèòü â êîíåö
|
||||
Dim aRange As Word.Range: Set aRange = ActiveDocument.ActiveWindow.Selection.Range
|
||||
aRange.Start = aRange.Paragraphs.First.Range.Start
|
||||
aRange.End = aRange.Paragraphs.Last.Range.End
|
||||
|
||||
Call aRange.Copy
|
||||
|
||||
Call ActiveDocument.Paragraphs.Add
|
||||
Call ActiveDocument.Paragraphs.Last.Range.Paste
|
||||
|
||||
aRange.HighlightColorIndex = wdYellow
|
||||
End Sub
|
||||
|
||||
Public Sub CC_CreateHLink()
|
||||
Dim target As Word.Range: Set target = ActiveDocument.ActiveWindow.Selection.Range
|
||||
|
||||
Dim bookmarkID$
|
||||
Dim aBM As Word.Bookmark
|
||||
For Each aBM In target.Bookmarks
|
||||
If aBM.Range.End = target.End And aBM.Range.Start = target.Start Then bookmarkID = aBM.Name
|
||||
Next aBM
|
||||
|
||||
If bookmarkID = vbNullString Then
|
||||
On Error GoTo ERROR_MSG
|
||||
bookmarkID = "AUTO_" & Format(Date, "yyyymmdd") & Replace(Time, ":", "")
|
||||
Call target.Bookmarks.Add(bookmarkID)
|
||||
End If
|
||||
|
||||
Call AddToClipboard(target.Text)
|
||||
DoEvents
|
||||
Call AddToClipboard(ActiveDocument.FullName & "#" & bookmarkID)
|
||||
Exit Sub
|
||||
|
||||
ERROR_MSG:
|
||||
Call UserInteraction.ShowMessage(EM_HYPERLINK_CREATION_FAIL)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RemoveExternalHyperlinks()
|
||||
Dim target As Word.Range: Set target = ActiveDocument.ActiveWindow.Selection.Range.Duplicate
|
||||
Dim aLink As Hyperlink
|
||||
Dim nLink&: nLink = 1
|
||||
Dim delCount&: delCount = 0
|
||||
Do While target.Hyperlinks.Count >= nLink
|
||||
Set aLink = target.Hyperlinks.Item(nLink)
|
||||
If aLink.Address <> vbNullString Then
|
||||
Call aLink.Range.Font.Reset
|
||||
delCount = delCount + 1
|
||||
Call aLink.Delete
|
||||
Else
|
||||
nLink = nLink + 1
|
||||
End If
|
||||
Loop
|
||||
Call Word.Application.ScreenRefresh
|
||||
Call UserInteraction.ShowMessage(IM_REMOVE_HYPERLINKS_OK, delCount)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RemoveAllHyperlinks()
|
||||
Dim target As Word.Range: Set target = ActiveDocument.ActiveWindow.Selection.Range.Duplicate
|
||||
Dim aLink As Hyperlink
|
||||
Dim delCount&: delCount = target.Hyperlinks.Count
|
||||
Do While target.Hyperlinks.Count > 0
|
||||
Set aLink = target.Hyperlinks.Item(1)
|
||||
Call aLink.Range.Font.Reset
|
||||
Call aLink.Delete
|
||||
Loop
|
||||
Call Word.Application.ScreenRefresh
|
||||
Call UserInteraction.ShowMessage(IM_REMOVE_HYPERLINKS_OK, delCount)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RemoveImages()
|
||||
Dim nDeleted&: nDeleted = RemoveImages(ActiveDocument.ActiveWindow.Selection.Range.Duplicate)
|
||||
Call Word.Application.ScreenRefresh
|
||||
Call UserInteraction.ShowMessage(IM_REMOVE_IMAGES_OK, nDeleted)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RemoveBookmarks()
|
||||
Dim target As Word.Range: Set target = ActiveDocument.ActiveWindow.Selection.Range.Duplicate
|
||||
Dim aBM As Word.Bookmark
|
||||
Dim delCount&: delCount = target.Bookmarks.Count
|
||||
Do While target.Bookmarks.Count > 0
|
||||
Set aBM = target.Bookmarks.Item(1)
|
||||
Call aBM.Delete
|
||||
Loop
|
||||
Call Word.Application.ScreenRefresh
|
||||
Call UserInteraction.ShowMessage(IM_REMOVE_BOOKMARKS_OK, delCount)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_RemoveAccents()
|
||||
Dim target As Word.Range: Set target = ActiveDocument.ActiveWindow.Selection.Range.Duplicate
|
||||
If target.Start = target.End Then _
|
||||
Set target = ActiveDocument.Range
|
||||
|
||||
Dim nCount&: nCount = RemoveAccentsIn(target)
|
||||
Call Word.Application.ScreenRefresh
|
||||
Call UserInteraction.ShowMessage(IM_REMOVE_ACCENTS_OK, nCount)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_MasterText()
|
||||
Dim sPath$: sPath = Word.ActiveDocument.FullName
|
||||
If Word.ActiveDocument.Path = vbNullString Then
|
||||
Call UserInteraction.ShowMessage(EM_DOCUMENT_NOT_SAVED)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim xlWrap As New API_XLWrapper
|
||||
Dim aDoc As Excel.Workbook: Set aDoc = xlWrap.OpenDocument(SERVER_MASTER_TEXT)
|
||||
If aDoc Is Nothing Then _
|
||||
Exit Sub
|
||||
|
||||
Call aDoc.Activate
|
||||
aDoc.Names(CELL_MASTER_PATH).RefersToRange = sPath$
|
||||
End Sub
|
||||
|
||||
Public Sub CC_UpdateConcept()
|
||||
If Not UpdateConceptPowershell Then
|
||||
Call UserInteraction.ShowMessage(EM_CORE_UPDATE_FAILED)
|
||||
Exit Sub
|
||||
End If
|
||||
Call UserInteraction.ShowMessage(IM_CONCEPT_UPDATE_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_Checkup()
|
||||
Call ExecuteAllRules(ActiveDocument, bApplyFix:=False)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_FixErrors()
|
||||
Call ExecuteAllRules(ActiveDocument, bApplyFix:=True)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_MasterConfig()
|
||||
Call OpenMasterConfig
|
||||
End Sub
|
||||
|
||||
Public Sub CC_IgnoreSelected()
|
||||
' Äîáàâëÿåì áóêìàðê ñ èãíîðîì äëÿ âûáðàííîãî äèàïàçîíà
|
||||
Dim target As Word.Range: Set target = ActiveDocument.Application.Selection.Range
|
||||
If target.Start = target.End Then
|
||||
Call UserInteraction.ShowMessage(EM_SELECTION_EMPTY)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim iEditor As New API_WordEditGuard: Call iEditor.InitDoc(target.Document)
|
||||
Dim sBookmark$: sBookmark = iEditor.BookmarkIgnored(target)
|
||||
Call UserInteraction.ShowMessage(IM_BOOKMARK_IGNORED, sBookmark)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_Help()
|
||||
Dim wordWrap As New API_WordWrapper
|
||||
Dim helpDoc As Word.Document: Set helpDoc = wordWrap.OpenDocument(SERVER_PATH_HELP, bReadOnly:=True)
|
||||
If helpDoc Is Nothing Then _
|
||||
Exit Sub
|
||||
|
||||
With helpDoc
|
||||
.ActiveWindow.View.ReadingLayout = False
|
||||
Call .Application.Activate
|
||||
End With
|
||||
End Sub
|
||||
|
||||
' ============
|
||||
Private Function ExecuteAllRules(iDoc As Word.Document, Optional bApplyFix As Boolean = True)
|
||||
Dim iConfig As API_Config: Set iConfig = LoadEditConfig
|
||||
Dim iProcessor As New RulesProcessor: Call iProcessor.Init(iDoc, iConfig)
|
||||
Dim iGuard As New API_WordEditGuard: Call iGuard.InitDoc(iDoc)
|
||||
|
||||
Call iGuard.BeginEdit(iConfig.GetValue("TrackRevisions"))
|
||||
|
||||
Call CSE_ProgressBar.Init("Àâòîìàòèçèðîâàííàÿ ñèñòåìà òåñòèðîâàíèÿ", sHeader:="Âûïîëíÿåòñÿ ïðîâåðêà, ïîäîæäèòå...", maxVal:=iProcessor.RuleCount, canInterrupt:=True)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
Call iProcessor.RunAll(CollectionToDictionary(iConfig.GetValue("ExcludeRules")), bApplyFix)
|
||||
|
||||
Dim nMilliseconds&: nMilliseconds = Int(CSE_ProgressBar.Time)
|
||||
CSE_ProgressBar.Description = "Ðàññòàíîâêà êîììåíòàðèåâ"
|
||||
Call iGuard.EndEdit
|
||||
|
||||
Call Unload(CSE_ProgressBar)
|
||||
Call UserInteraction.ShowMessage(IM_RULES_COMPLETE, nMilliseconds, iProcessor.errors_, iProcessor.fixes_)
|
||||
End Function
|
||||
247
src/MainImpl.bas
Normal file
247
src/MainImpl.bas
Normal file
|
|
@ -0,0 +1,247 @@
|
|||
Attribute VB_Name = "MainImpl"
|
||||
Option Explicit
|
||||
|
||||
Public Function RemoveImages(target As Word.Range) As Long
|
||||
Dim iShp As Word.InlineShape
|
||||
Dim nDeleted&: nDeleted = target.InlineShapes.Count
|
||||
Do While target.InlineShapes.Count > 0
|
||||
Set iShp = target.InlineShapes.Item(1)
|
||||
Dim pasteRange As Word.Range: Set pasteRange = iShp.Range.Duplicate
|
||||
Call pasteRange.Collapse(wdCollapseStart)
|
||||
Call iShp.Delete
|
||||
pasteRange.Text = "[èçîáðàæåíèå óäàëåíî]"
|
||||
pasteRange.Font.Bold = True
|
||||
Loop
|
||||
RemoveImages = nDeleted
|
||||
End Function
|
||||
|
||||
Public Function RecreateBookmarks(target As Word.Document) As Scripting.Dictionary
|
||||
Dim contextMap As New Scripting.Dictionary
|
||||
Dim pref$: pref = "t" & VBA.Format(Date, "yyyymmdd") & VBA.Replace(VBA.Time, ":", "")
|
||||
Dim nBookmark&
|
||||
For nBookmark = target.Bookmarks.Count To 1 Step -1 ' Note: reverse order for recreation
|
||||
Dim aMark As Word.Bookmark: Set aMark = target.Bookmarks(nBookmark)
|
||||
Dim bmRange As Word.Range: Set bmRange = aMark.Range
|
||||
Dim sNewName$: sNewName = pref & "_" & aMark.Name
|
||||
If VBA.Len(sNewName) > 40 Then _
|
||||
GoTo NEXT_BM
|
||||
|
||||
Call contextMap.Add(aMark.Name, sNewName)
|
||||
Call bmRange.Bookmarks.Add(pref & "_" & aMark.Name)
|
||||
Call aMark.Delete
|
||||
NEXT_BM:
|
||||
Next nBookmark
|
||||
|
||||
Set RecreateBookmarks = contextMap
|
||||
End Function
|
||||
|
||||
Public Function FixHyperlinksAfterBMReplace(target As Word.Document, iContext As Scripting.Dictionary)
|
||||
Dim newAddr$
|
||||
Dim nLink&
|
||||
For nLink = target.Hyperlinks.Count To 1 Step -1
|
||||
Dim aLink As Word.Hyperlink: Set aLink = target.Hyperlinks(nLink)
|
||||
Dim linkRange As Word.Range: Set linkRange = target.Range(aLink.Range.Start, aLink.Range.End)
|
||||
Dim sSub$: sSub = aLink.SubAddress
|
||||
If Not aLink.Address = vbNullString Or sSub = vbNullString Then _
|
||||
GoTo NEXT_LINK
|
||||
If Not iContext.Exists(sSub) Then _
|
||||
GoTo NEXT_LINK
|
||||
|
||||
newAddr = iContext(sSub)
|
||||
Call aLink.Delete
|
||||
Call linkRange.Hyperlinks.Add(linkRange, "", newAddr)
|
||||
|
||||
NEXT_LINK:
|
||||
Next nLink
|
||||
End Function
|
||||
|
||||
Public Function FixHyperlinksIn(target As Word.Range) As LMU_LinksInfo
|
||||
FixHyperlinksIn.lnkCount_ = target.Hyperlinks.Count
|
||||
|
||||
Call CSE_ProgressBar.Init("Ïðåîáðàçîâàíèå ãèïåðññûëîê", sHeader:="Îáðàáîòêà...", _
|
||||
maxVal:=FixHyperlinksIn.lnkCount_)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
FixHyperlinksIn.modCount_ = 0
|
||||
FixHyperlinksIn.errCount_ = 0
|
||||
|
||||
Dim aLink As Hyperlink
|
||||
For Each aLink In target.Hyperlinks
|
||||
Dim linkAdr$: linkAdr = GetFullPath(SafeGetHLinkAddress(aLink), target.Document.Path)
|
||||
If linkAdr = vbNullString Then _
|
||||
GoTo NEXT_LINK
|
||||
|
||||
Select Case LinkCheckResult(linkAdr)
|
||||
Case RV_LINK_FIXED:
|
||||
FixHyperlinksIn.modCount_ = FixHyperlinksIn.modCount_ + 1
|
||||
Dim linkRange As Word.Range: Set linkRange = aLink.Range
|
||||
If linkRange.Font.ColorIndex = wdRed Then _
|
||||
linkRange.Font.ColorIndex = wdAuto
|
||||
If linkRange.HighlightColorIndex = wdTurquoise Then _
|
||||
linkRange.HighlightColorIndex = wdAuto
|
||||
|
||||
If IsSamePath(linkRange.Text, SafeGetHLinkAddress(aLink), target.Document.Path) Then
|
||||
If Left(linkRange.Text, 2) = "\\" Then
|
||||
linkRange.Text = ConvertLinkToLocal(linkAdr)
|
||||
Else
|
||||
linkRange.Text = ConvertLinkToURL(linkAdr)
|
||||
End If
|
||||
End If
|
||||
|
||||
linkRange.Text = linkRange.Text
|
||||
Call ActiveDocument.Hyperlinks.Add(linkRange, linkAdr)
|
||||
|
||||
Case RV_LINK_NOFIX:
|
||||
FixHyperlinksIn.errCount_ = FixHyperlinksIn.errCount_ + 1
|
||||
If aLink.Range.HighlightColorIndex <> wdTurquoise Then
|
||||
aLink.Range.HighlightColorIndex = wdTurquoise
|
||||
End If
|
||||
End Select
|
||||
|
||||
NEXT_LINK:
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
Next aLink
|
||||
|
||||
Call Unload(CSE_ProgressBar)
|
||||
End Function
|
||||
|
||||
Public Function TryFixingParagraph(ByRef target As Word.Range)
|
||||
Dim nLine&: nLine = target.ComputeStatistics(wdStatisticLines)
|
||||
Dim newLine&
|
||||
Dim oldSpace As Double: oldSpace = target.Font.Spacing
|
||||
Dim dSpace As Double: dSpace = oldSpace
|
||||
|
||||
Do While dSpace >= -PAR_SCALE_MAX
|
||||
On Error GoTo ERR_H
|
||||
target.Font.Spacing = dSpace
|
||||
GoTo ERR_NEXT
|
||||
ERR_H:
|
||||
oldSpace = 0
|
||||
dSpace = 0
|
||||
target.Font.Spacing = dSpace
|
||||
ERR_NEXT:
|
||||
|
||||
newLine = target.ComputeStatistics(wdStatisticLines)
|
||||
If newLine < nLine Then _
|
||||
Exit Function
|
||||
|
||||
dSpace = dSpace - PAR_SCALE_STEP
|
||||
Loop
|
||||
|
||||
target.Font.Spacing = oldSpace
|
||||
|
||||
Dim colWid As Double, finC As Double
|
||||
Dim finRng As Word.Range, curSel As Word.Range
|
||||
|
||||
Set curSel = target.Application.Selection.Range.Duplicate
|
||||
|
||||
Set finRng = target.Duplicate
|
||||
Call finRng.MoveEnd(wdCharacter, -1)
|
||||
Call finRng.Collapse(wdCollapseEnd)
|
||||
Call finRng.Select
|
||||
|
||||
' Äëÿ ñëó÷àåâ, êîãäà òåêñò â òàáëèöå
|
||||
On Error GoTo RET_SEL
|
||||
colWid = target.PageSetup.TextColumns(1).Width
|
||||
On Error GoTo 0
|
||||
|
||||
Do While dSpace <= PAR_SCALE_MAX
|
||||
On Error GoTo ERR_V
|
||||
target.Font.Spacing = dSpace
|
||||
GoTo ERR_NEW
|
||||
ERR_V:
|
||||
oldSpace = 0
|
||||
dSpace = 0
|
||||
target.Font.Spacing = dSpace
|
||||
ERR_NEW:
|
||||
|
||||
newLine = target.ComputeStatistics(wdStatisticLines)
|
||||
If newLine < nLine Then _
|
||||
GoTo RET_SEL
|
||||
If newLine > nLine Then _
|
||||
Exit Do
|
||||
|
||||
finC = target.Application.Selection.Information(wdHorizontalPositionRelativeToTextBoundary)
|
||||
If finC / colWid >= 0.5 Then _
|
||||
GoTo RET_SEL
|
||||
|
||||
dSpace = dSpace + PAR_SCALE_STEP
|
||||
Loop
|
||||
|
||||
target.Font.Spacing = oldSpace
|
||||
|
||||
RET_SEL:
|
||||
Call curSel.Select
|
||||
End Function
|
||||
|
||||
Public Function LowerReference(execField As Word.Field)
|
||||
If execField.Type <> wdFieldRef Then _
|
||||
Exit Function
|
||||
|
||||
With execField
|
||||
Dim codeStr$: codeStr = .Code
|
||||
Dim fSlash&: fSlash = InStr(codeStr, "\")
|
||||
fSlash = IIf(fSlash = 0, Len(codeStr), fSlash)
|
||||
codeStr = Left(codeStr, fSlash - 1) & "\* Lower \h }"
|
||||
|
||||
.Code.Text = codeStr
|
||||
.Update
|
||||
|
||||
.result.Italic = True
|
||||
.result.Bold = True
|
||||
End With
|
||||
End Function
|
||||
|
||||
Public Function RemoveAccentsIn(target As Word.Range) As Long
|
||||
Dim nCount&: nCount = 0
|
||||
Dim aWord As Word.Range
|
||||
For Each aWord In target.Words
|
||||
Dim sInitial$: sInitial = aWord.Text
|
||||
Dim sFixed$: sFixed = VBA.Replace(sInitial, ChrW(769), "")
|
||||
If VBA.Len(sInitial) > VBA.Len(sFixed) Then
|
||||
nCount = nCount + VBA.Len(sInitial) - VBA.Len(sFixed)
|
||||
aWord = sFixed
|
||||
End If
|
||||
Next aWord
|
||||
RemoveAccentsIn = nCount
|
||||
End Function
|
||||
|
||||
Public Function UpdateConceptPowershell() As Boolean
|
||||
UpdateConceptPowershell = False
|
||||
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
Dim sInstall$: sInstall = CP_TOOLS_SERVER & "\" & CONCEPT_INSTALLER
|
||||
If Not fso.FileExists(sInstall) Then _
|
||||
Exit Function
|
||||
|
||||
On Error GoTo RETURN_FALSE
|
||||
Dim sExec$: sExec = "cmd.exe /c " & """" & sInstall & """" & " < nul"
|
||||
Dim iShell As New WshShell
|
||||
iShell.CurrentDirectory = CP_TOOLS_SERVER
|
||||
UpdateConceptPowershell = iShell.Run(sExec, waitOnReturn:=True) = 0
|
||||
Exit Function
|
||||
|
||||
RETURN_FALSE:
|
||||
On Error GoTo 0
|
||||
End Function
|
||||
|
||||
' =============
|
||||
Private Function LinkCheckResult(ByRef rawLnk$) As LMU_Return
|
||||
'Ñîñòîÿíèå ññûëîê (ñ ïîäìåíîé ñòðîêîâîé ïåðåìåííîé)
|
||||
Dim rulemap As LinkMappingUnit: Set rulemap = GetLMU
|
||||
Dim sResult$: sResult = rawLnk
|
||||
LinkCheckResult = rulemap.FixLink(sResult)
|
||||
If LinkCheckResult = RV_LINK_FIXED Then _
|
||||
rawLnk = sResult
|
||||
End Function
|
||||
|
||||
Private Function TryProcessAddin(sLocal$, sServer$) As Boolean
|
||||
TryProcessAddin = False
|
||||
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
If Not fso.FileExists(sServer) Then _
|
||||
Exit Function
|
||||
|
||||
Call fso.CopyFile(sServer, sLocal)
|
||||
TryProcessAddin = True
|
||||
End Function
|
||||
144
src/PublicSubs.bas
Normal file
144
src/PublicSubs.bas
Normal file
|
|
@ -0,0 +1,144 @@
|
|||
Attribute VB_Name = "PublicSubs"
|
||||
Option Explicit
|
||||
|
||||
Public Sub CCM_AddColumnBreak()
|
||||
Dim selPar As Word.Range: Set selPar = ActiveDocument.ActiveWindow.Selection.Paragraphs.First.Range
|
||||
Call selPar.Collapse(wdCollapseStart)
|
||||
Call selPar.InsertBreak(wdColumnBreak)
|
||||
End Sub
|
||||
|
||||
Public Sub CCM_NonBreakPar()
|
||||
ActiveDocument.ActiveWindow.Selection.ParagraphFormat.KeepTogether = Not ActiveDocument.ActiveWindow.Selection.ParagraphFormat.KeepTogether
|
||||
End Sub
|
||||
|
||||
Public Sub CCM_WithNext()
|
||||
Selection.ParagraphFormat.KeepWithNext = Not Selection.ParagraphFormat.KeepWithNext
|
||||
End Sub
|
||||
|
||||
Public Sub CCM_FieldLowerer()
|
||||
Dim tmpRange As Word.Range: Set tmpRange = ActiveDocument.ActiveWindow.Selection.Range.Duplicate
|
||||
tmpRange.Start = ActiveDocument.ActiveWindow.Selection.Words.First.Start
|
||||
tmpRange.End = ActiveDocument.ActiveWindow.Selection.Words.Last.End
|
||||
|
||||
On Error GoTo EXT_SUB
|
||||
Dim execField As Word.Field
|
||||
For Each execField In tmpRange.Fields
|
||||
Call bilCrossRef(execField)
|
||||
Next execField
|
||||
EXT_SUB:
|
||||
End Sub
|
||||
|
||||
Public Sub CCM_MakeUniqueBM()
|
||||
' Êîíâåðòèðóåò èìåíà çàêëàäîê â óíèêàëüíûå
|
||||
Dim contextMap As New Collection
|
||||
|
||||
Dim pref$: pref = "t" & Format(Date, "yyyymmdd") & Replace(Time, ":", "")
|
||||
Dim i&
|
||||
For i = ActiveDocument.Bookmarks.Count To 1 Step -1 ' Â îáðàòíîì ïîðÿäêå ïîñêîëüêó ìû áóäåì èõ ïåðåñîçäàâàòü
|
||||
Dim aMark As Word.BookMark: Set aMark = ActiveDocument.Bookmarks(i)
|
||||
Dim bmRange As Word.Range: Set bmRange = aMark.Range
|
||||
Dim newName$: newName = pref & "_" & aMark.Name
|
||||
|
||||
' Ïðîâåðÿåì êîððåêòíîñòü äëèíû áóêìàðêà
|
||||
If Len(newName) > 40 Then _
|
||||
GoTo NEXT_BM
|
||||
|
||||
Call contextMap.Add(newName, aMark.Name)
|
||||
Call bmRange.Bookmarks.Add(pref & "_" & aMark.Name)
|
||||
Call aMark.Delete
|
||||
NEXT_BM:
|
||||
Next i
|
||||
|
||||
' Ïðàâèì âíóòðåííèå ññûëêè íà çàêëàäêè
|
||||
Dim newAddr$
|
||||
For i = ActiveDocument.Hyperlinks.Count To 1 Step -1
|
||||
Dim aLink As Word.Hyperlink: Set aLink = ActiveDocument.Hyperlinks(i)
|
||||
Dim linkRange As Word.Range: Set linkRange = ActiveDocument.Range(aLink.Range.Start, aLink.Range.End)
|
||||
If Not aLink.Address = "" Or aLink.SubAddress = "" Then _
|
||||
GoTo NEXT_LINK
|
||||
If Not InCollection(aLink.SubAddress, contextMap) Then _
|
||||
GoTo NEXT_LINK
|
||||
|
||||
newAddr = contextMap(aLink.SubAddress)
|
||||
Call aLink.Delete
|
||||
Call linkRange.Hyperlinks.Add(linkRange, "", newAddr)
|
||||
|
||||
NEXT_LINK:
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
Public Sub CCM_ConvertAllShapesToText()
|
||||
' Ïðâðàùåíèå øåéïîâ â òåêñò
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
Dim tRange As Word.Range: Set tRange = theDoc.Range
|
||||
|
||||
Dim nShape&: nShape = 1
|
||||
Dim theText$
|
||||
|
||||
Dim aShape As Word.Shape
|
||||
Do While nShape <= theDoc.Shapes.Count ' Èòåðàöèÿ ïî íîìåðàì ïîñêîëüêó íóæíî óäàëÿòü ñàìè øåéïû
|
||||
Set aShape = theDoc.Shapes(nShape)
|
||||
If Not aShape.Anchor.InRange(tRange) Then _
|
||||
GoTo NEXT_SHAPE
|
||||
If aShape.Type <> msoTextBox Then _
|
||||
GoTo NEXT_SHAPE
|
||||
|
||||
theText = aShape.TextFrame.TextRange.Text
|
||||
|
||||
aShape.TextFrame.TextRange.Copy
|
||||
tRange.Paragraphs.Add
|
||||
Call tRange.Paragraphs.Last.Range.Paste
|
||||
|
||||
NEXT_SHAPE:
|
||||
nShape = nShape + 1
|
||||
Loop
|
||||
|
||||
Call UserInteraction.ShowMessage(IM_SHAPES_TO_TEXT_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CC_Convert1252_1251()
|
||||
' Êîíâåðòàöèÿ êîäîâûõ ñòðàíèö
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
theDoc.ActiveWindow.View.ReadingLayout = False
|
||||
|
||||
Dim inputR As Word.Range: Set inputR = theDoc.Application.Selection.Range
|
||||
|
||||
Dim wordUI As New API_WordWrapper: Call wordUI.SetDocument(theDoc)
|
||||
Call wordUI.PauseUI
|
||||
|
||||
Call CSE_ProgressBar.Init("Êîððåêòèðîâêà êîäèðîâêè 1252 -> 1251", sHeader:="Îáðàáîòêà ñèìâîëîâ...", maxVal:=inputR.Characters.Count)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
Dim aChr As Word.Range: Set aChr = inputR.Characters.First
|
||||
Do While aChr.End < inputR.End
|
||||
Dim chrW&: chrW = VBA.AscW(aChr)
|
||||
If chrW < 256 And chrW > 127 Then _
|
||||
aChr.Text = VBA.Chr(chrW)
|
||||
Set aChr = aChr.Next(wdCharacter, 1)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
Loop
|
||||
|
||||
Call Unload(CSE_ProgressBar)
|
||||
Call wordUI.ResumeUI
|
||||
Call UserInteraction.ShowMessage(IM_CONVERT_CODEPAGE_OK)
|
||||
End Sub
|
||||
|
||||
' ============
|
||||
Private Function bilCrossRef(execField As Word.Field)
|
||||
If execField.Type <> wdFieldRef Then _
|
||||
Exit Function
|
||||
|
||||
With execField
|
||||
Dim codeStr$: codeStr = .code
|
||||
Dim fSlash&: fSlash = InStr(codeStr, "\")
|
||||
fSlash = IIf(fSlash = 0, Len(codeStr), fSlash)
|
||||
codeStr = Left(codeStr, fSlash - 1) & "\* Lower \h }"
|
||||
|
||||
.code.Text = codeStr
|
||||
.Update
|
||||
|
||||
.result.Italic = True
|
||||
.result.Bold = True
|
||||
End With
|
||||
End Function
|
||||
|
||||
137
src/RulesAccess.bas
Normal file
137
src/RulesAccess.bas
Normal file
|
|
@ -0,0 +1,137 @@
|
|||
Attribute VB_Name = "RulesAccess"
|
||||
' Grant access to document processing rules
|
||||
Option Explicit
|
||||
|
||||
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 InitProcessor(sDocument$, sConfigJSON$) As Boolean
|
||||
On Error GoTo RETURN_FALSE
|
||||
Dim iWrap As New API_WordWrapper
|
||||
If iWrap.OpenDocument(sDocument) Is Nothing Then _
|
||||
GoTo RETURN_FALSE
|
||||
|
||||
Dim iConfig As New API_Config: Call iConfig.LoadFromJSON(sConfigJSON)
|
||||
Call AccessProcessor.Init(iWrap.Document, iConfig)
|
||||
InitProcessor = True
|
||||
Exit Function
|
||||
|
||||
RETURN_FALSE:
|
||||
InitProcessor = False
|
||||
End Function
|
||||
|
||||
Public Function RunRule(sRuleID$, Optional bApplyFix As Boolean = True) As Long()
|
||||
Dim iResult() As Long
|
||||
ReDim iResult(0 To 2)
|
||||
|
||||
Dim iProcessor As RulesProcessor: Set iProcessor = AccessProcessor
|
||||
|
||||
On Error GoTo RETURN_ERROR
|
||||
Call iProcessor.ResetCounters
|
||||
Call iProcessor.RunRule(sRuleID, bApplyFix)
|
||||
On Error GoTo 0
|
||||
|
||||
iResult(0) = 0
|
||||
iResult(1) = iProcessor.errors_
|
||||
iResult(2) = iProcessor.fixes_
|
||||
RunRule = iResult
|
||||
Exit Function
|
||||
|
||||
RETURN_ERROR:
|
||||
iResult(0) = Err.Number
|
||||
RunRule = iResult
|
||||
End Function
|
||||
|
||||
Public Function FinalizeRulesProcessing()
|
||||
Call AccessProcessor.FinalizeProcessing
|
||||
End Function
|
||||
|
||||
Public Function EmptyEditConfig() As API_Config
|
||||
Set EmptyEditConfig = New API_Config
|
||||
With EmptyEditConfig
|
||||
Call .SetValue("HighlightErrors", False)
|
||||
Call .SetValue("CommentUnresolved", True)
|
||||
Call .SetValue("TrackRevisions", False)
|
||||
Call .SetValue("ExcludeRules", New Collection)
|
||||
Call .SetValue("BannedWords", New Collection)
|
||||
End With
|
||||
End Function
|
||||
|
||||
Public Function DefaultEditConfig() As API_Config
|
||||
Set DefaultEditConfig = New API_Config
|
||||
With DefaultEditConfig
|
||||
Call .SetValue("HighlightErrors", False)
|
||||
Call .SetValue("CommentUnresolved", True)
|
||||
Call .SetValue("TrackRevisions", True)
|
||||
Call .SetValue("ExcludeRules", New Collection)
|
||||
Call .SetValue("BannedWords", LoadBannedWords)
|
||||
End With
|
||||
End Function
|
||||
|
||||
Public Function LoadEditConfig() As API_Config
|
||||
Dim iConfig As API_Config
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
Dim sFile$: sFile = VBA.Environ$("USERPROFILE") & "\" & CONCEPT_LOCAL_HOME & "\" & CONCEPT_MASTER_CONFIG
|
||||
If fso.FileExists(sFile) Then
|
||||
Set iConfig = New API_Config
|
||||
Call iConfig.LoadFromFile(sFile)
|
||||
Else
|
||||
Set iConfig = DefaultEditConfig
|
||||
Call iConfig.RemoveKey("BannedWords")
|
||||
Call iConfig.SaveToFile(sFile)
|
||||
End If
|
||||
Call iConfig.SetValue("BannedWords", LoadBannedWords)
|
||||
Set LoadEditConfig = iConfig
|
||||
End Function
|
||||
|
||||
Public Function OpenMasterConfig()
|
||||
Dim fso As New Scripting.FileSystemObject
|
||||
Dim sFile$: sFile = VBA.Environ$("USERPROFILE") & "\" & CONCEPT_LOCAL_HOME & "\" & CONCEPT_MASTER_CONFIG
|
||||
If Not fso.FileExists(sFile) Then
|
||||
Dim iConfig As API_Config: Set iConfig = DefaultEditConfig
|
||||
Call iConfig.RemoveKey("BannedWords")
|
||||
Call iConfig.SaveToFile(sFile)
|
||||
End If
|
||||
Dim oShell As New Shell32.Shell
|
||||
Call oShell.Open(sFile)
|
||||
End Function
|
||||
|
||||
' =======
|
||||
Private Function LoadBannedWords() As Collection
|
||||
Dim result As New Collection
|
||||
Dim sLocal$: sLocal = VBA.Environ$("USERPROFILE") & "\" & CONCEPT_LOCAL_HOME & "\models\" & 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 = VBA.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
|
||||
|
||||
Private Function TryUpdateBannedWords() As Boolean
|
||||
Dim sServer$: sServer = CONCEPT_SERVER_HOME & CONCEPT_BANNED_WORDS
|
||||
Dim sLocal$: sLocal = VBA.Environ$("USERPROFILE") & "\" & CONCEPT_LOCAL_HOME & "\models\" & CONCEPT_BANNED_WORDS
|
||||
TryUpdateBannedWords = CopyFileOrFolder(sSource:=sServer, sDestination:=sLocal)
|
||||
End Function
|
||||
1162
src/RulesProcessor.cls
Normal file
1162
src/RulesProcessor.cls
Normal file
File diff suppressed because it is too large
Load Diff
209
src/s_RulesProcessor.cls
Normal file
209
src/s_RulesProcessor.cls
Normal file
|
|
@ -0,0 +1,209 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "s_RulesProcessor"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
' TODO: test all missing rules
|
||||
|
||||
Private processor_ As RulesProcessor
|
||||
Private doc_ As Word.Document
|
||||
Private ruleID_ As String
|
||||
|
||||
Public Function Setup()
|
||||
Set doc_ = ThisDocument
|
||||
Set processor_ = New RulesProcessor
|
||||
Call processor_.Init(doc_, EmptyEditConfig)
|
||||
End Function
|
||||
|
||||
Public Function Teardown()
|
||||
Call doc_.Range.Delete
|
||||
End Function
|
||||
|
||||
Private Function TestText(sInitial$, sExpected$, Optional sMsg$ = vbNullString)
|
||||
Dim nStart&: nStart = doc_.Range.End
|
||||
Call doc_.Paragraphs.Add.Range.InsertAfter(sInitial)
|
||||
|
||||
Call processor_.ResetCounters
|
||||
Call processor_.RunRule(ruleID_, bApplyFix:=True)
|
||||
|
||||
Dim iLastRange As Word.Range: Set iLastRange = doc_.Range.Duplicate
|
||||
iLastRange.Start = nStart
|
||||
iLastRange.End = iLastRange.End - 1
|
||||
Dim sTest$: sTest = iLastRange.Text
|
||||
Call doc_.Range.Delete
|
||||
|
||||
Call Dev_ExpectEQ(sExpected, sTest, sMsg)
|
||||
End Function
|
||||
|
||||
Private Function TestComment(sInitial$, sAnchor$, Optional sComment$ = vbNullString, Optional sClause$ = vbNullString)
|
||||
If sClause <> "" Then _
|
||||
Call Dev_NewClause(sClause)
|
||||
|
||||
Call doc_.Paragraphs.Add.Range.InsertAfter(sInitial)
|
||||
|
||||
Call processor_.RunRule(ruleID_, bApplyFix:=True)
|
||||
Call processor_.FinalizeProcessing
|
||||
Call Dev_AssertEQ(1, doc_.Comments.Count, "Comments count")
|
||||
|
||||
Dim iComment As Word.Comment: Set iComment = doc_.Comments(1)
|
||||
|
||||
Dim sText$: sText = iComment.Range.Text
|
||||
Call Dev_ExpectEQ(sAnchor, iComment.Scope, "Anchor text")
|
||||
If sComment <> "" Then
|
||||
Call Dev_ExpectLike(sText, "*" & sComment, "Comment text")
|
||||
End If
|
||||
|
||||
Call doc_.Range.Delete
|
||||
End Function
|
||||
|
||||
Public Function t_HiddenText()
|
||||
On Error GoTo PROPAGATE_ERROR
|
||||
ruleID_ = "AR1002"
|
||||
|
||||
Dim sText$: sText = "Test1 Test2"
|
||||
Dim nStart&: nStart = doc_.Range.End
|
||||
Call doc_.Paragraphs.Add.Range.InsertAfter(sText)
|
||||
Dim iLastRange As Word.Range: Set iLastRange = doc_.Range.Duplicate
|
||||
iLastRange.Start = nStart
|
||||
iLastRange.End = iLastRange.End - 1
|
||||
iLastRange.Font.Hidden = True
|
||||
|
||||
Call processor_.RunRule(ruleID_, bApplyFix:=True)
|
||||
|
||||
Set iLastRange = doc_.Range.Duplicate
|
||||
iLastRange.Start = nStart
|
||||
iLastRange.End = iLastRange.End - 1
|
||||
Dim sTest$: sTest = iLastRange.Text
|
||||
|
||||
Call Dev_ExpectEQ(sText, sTest, "Do not apply rule to hidden text")
|
||||
|
||||
iLastRange.Font.Hidden = False
|
||||
Call processor_.RunRule(ruleID_, bApplyFix:=True)
|
||||
|
||||
Set iLastRange = doc_.Range.Duplicate
|
||||
iLastRange.Start = nStart
|
||||
iLastRange.End = iLastRange.End - 1
|
||||
sTest = iLastRange.Text
|
||||
Call Dev_ExpectNE(sText, sTest, "Apply valid rule to not hidden text")
|
||||
|
||||
Exit Function
|
||||
PROPAGATE_ERROR:
|
||||
Call Dev_LogError(Err.Number, Err.Description)
|
||||
End Function
|
||||
|
||||
Public Function t_ParagraphWhitespace()
|
||||
On Error GoTo PROPAGATE_ERROR
|
||||
ruleID_ = "AR1001"
|
||||
|
||||
Call Dev_NewCase("Space in front")
|
||||
Call TestText(" Test", "Test", "Single space")
|
||||
Call TestText(" Test", "Test", "Multiple spaces")
|
||||
Call TestText(Chr(160) & "Test", "Test", "Unbreakable space")
|
||||
Call TestText(Chr(160) & " " & Chr(160) & "Test", "Test", "Mixed spaces")
|
||||
Call TestText(vbTab & "Test", vbTab & "Test", "Ignore tabulator")
|
||||
Call TestText(" " & vbTab & "Test", vbTab & "Test", "Mixed tabulator")
|
||||
|
||||
Call Dev_NewCase("Space in back")
|
||||
Call TestText("Test ", "Test", "Single space")
|
||||
Call TestText("Test ", "Test", "Multiple spaces")
|
||||
Call TestText("Test" & Chr(160), "Test", "Unbreakable space")
|
||||
Call TestText("Test" & Chr(160) & " " & Chr(160), "Test", "Mixed spaces")
|
||||
Call TestText("Test" & vbTab, "Test", "Tabulator")
|
||||
Call TestText("Test" & vbTab & vbTab, "Test", "Multiple tabulator")
|
||||
Call TestText("Test" & " " & vbTab, "Test", "Mixed tabulator")
|
||||
|
||||
Call Dev_NewCase("Combo spaces")
|
||||
Call TestText(" Test " & vbTab, "Test")
|
||||
|
||||
Exit Function
|
||||
PROPAGATE_ERROR:
|
||||
Call Dev_LogError(Err.Number, Err.Description)
|
||||
End Function
|
||||
|
||||
Public Function t_DoubleSpace()
|
||||
On Error GoTo PROPAGATE_ERROR
|
||||
ruleID_ = "AR1002"
|
||||
|
||||
Call TestText("Test1 test2", "Test1 test2", "Double space")
|
||||
Call TestText("Test1 " & Chr(160) & "test2", "Test1 test2", "Double unbreakable space")
|
||||
Call TestText("Test1 test2", "Test1 test2", "Triple space")
|
||||
Call TestText("Test1" & vbTab & vbTab & "test2", "Test1" & vbTab & vbTab & "test2", "Double tab")
|
||||
|
||||
Call Dev_NewCase("Quadruple space")
|
||||
Call TestText("Test1 test2", "Test1 test2", "Replace text")
|
||||
Call Dev_ExpectEQ(1, processor_.errors_, "Error count")
|
||||
Call Dev_ExpectEQ(1, processor_.errors_, "Fixes count")
|
||||
|
||||
Exit Function
|
||||
PROPAGATE_ERROR:
|
||||
Call Dev_LogError(Err.Number, Err.Description)
|
||||
End Function
|
||||
|
||||
Public Function t_DoubleEndline()
|
||||
On Error GoTo PROPAGATE_ERROR
|
||||
ruleID_ = "AR1003"
|
||||
|
||||
Call TestText(vbNewLine & "Test", "Test", "Double endline")
|
||||
Call TestText("Test" & vbNewLine, "Test", "End of document")
|
||||
|
||||
Call Dev_NewCase("Triple endline")
|
||||
Call TestText(vbNewLine & vbNewLine & "Test", "Test", "Replace text")
|
||||
Call Dev_ExpectEQ(1, processor_.errors_, "Error count")
|
||||
Call Dev_ExpectEQ(1, processor_.errors_, "Fixes count")
|
||||
|
||||
Call Dev_NewCase("Quadruple endline")
|
||||
Call TestText(vbNewLine & vbNewLine & vbNewLine & "Test", "Test", "Replace text")
|
||||
Call Dev_ExpectEQ(1, processor_.errors_, "Error count")
|
||||
Call Dev_ExpectEQ(1, processor_.errors_, "Fixes count")
|
||||
|
||||
Exit Function
|
||||
PROPAGATE_ERROR:
|
||||
Call Dev_LogError(Err.Number, Err.Description)
|
||||
End Function
|
||||
|
||||
Public Function t_PlusMinus()
|
||||
On Error GoTo PROPAGATE_ERROR
|
||||
ruleID_ = "AR1004"
|
||||
|
||||
Call TestText("1 +/- 1", "1 ± 1", "Spaces")
|
||||
Call TestText("1+/-1", "1±1", "No spaces")
|
||||
Call TestText("1 + / - 1", "1 ± 1", "Inner spaces")
|
||||
|
||||
Exit Function
|
||||
PROPAGATE_ERROR:
|
||||
Call Dev_LogError(Err.Number, Err.Description)
|
||||
End Function
|
||||
|
||||
Public Function t_Quotes()
|
||||
On Error GoTo PROPAGATE_ERROR
|
||||
ruleID_ = "AR1017"
|
||||
|
||||
Call Dev_NewCase("Replace incorrect brackets")
|
||||
Call TestText("«Test»", "«Test»")
|
||||
Call TestText("""Test""", "«Test»")
|
||||
Call TestText("»Test«", "«Test»")
|
||||
Call TestText("„Test„", "«Test»")
|
||||
Call TestText("""""", "«»")
|
||||
Call TestText("»«", "«»")
|
||||
|
||||
Call Dev_NewCase("Double brackets")
|
||||
Call TestText("«ÍÏ «ÖÈÂÒ ÊÎÍÖÅÏÒ»»", "«ÍÏ „ÖÈÂÒ ÊÎÍÖÅÏÒ“»")
|
||||
Call TestText("""ÍÏ «ÖÈÂÒ ÊÎÍÖÅÏÒ«»", "«ÍÏ „ÖÈÂÒ ÊÎÍÖÅÏÒ“»")
|
||||
Call TestText("«ÍÏ «ÖÈÂÒ ÊÎÍÖÅÏÒ» INC»", "«ÍÏ «ÖÈÂÒ ÊÎÍÖÅÏÒ» INC»")
|
||||
|
||||
Call Dev_NewCase("Invalid structure")
|
||||
Call TestComment("«Test", "«", sClause:="Missing close bracket")
|
||||
Call TestComment("«Test «12»", "«", sClause:="Missing close bracket")
|
||||
Call TestComment("Test»", "", sClause:="Missing open bracket")
|
||||
|
||||
Exit Function
|
||||
PROPAGATE_ERROR:
|
||||
Call Dev_LogError(Err.Number, Err.Description)
|
||||
End Function
|
||||
|
||||
92
src/z_UIMessages.bas
Normal file
92
src/z_UIMessages.bas
Normal file
|
|
@ -0,0 +1,92 @@
|
|||
Attribute VB_Name = "z_UIMessages"
|
||||
' Messaging module
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Public Enum MsgCode
|
||||
EM_HYPERLINK_CREATION_FAIL
|
||||
EM_HYPERLINKS_MISSING
|
||||
EM_DOCUMENT_NOT_SAVED
|
||||
EM_CORE_UPDATE_FAILED
|
||||
EM_SELECTION_EMPTY
|
||||
EM_MISSING_FILE
|
||||
|
||||
IM_REMOVE_HYPERLINKS_OK
|
||||
IM_HYPERLINKS_FIX_OK
|
||||
IM_REMOVE_BOOKMARKS_OK
|
||||
IM_REMOVE_IMAGES_OK
|
||||
IM_SHAPES_TO_TEXT_OK
|
||||
IM_CONVERT_CODEPAGE_OK
|
||||
IM_UNIQUE_BOOKMARKS_OK
|
||||
IM_CONCEPT_UPDATE_OK
|
||||
IM_BOOKMARK_IGNORED
|
||||
IM_RULES_COMPLETE
|
||||
IM_REMOVE_ACCENTS_OK
|
||||
IM_COMMENT_EXPORT_OK
|
||||
End Enum
|
||||
|
||||
Private g_UI As API_UserInteraction
|
||||
|
||||
Public Function UserInteraction() As API_UserInteraction
|
||||
If g_UI Is Nothing Then _
|
||||
Set g_UI = New API_UserInteraction
|
||||
Set UserInteraction = g_UI
|
||||
End Function
|
||||
|
||||
Public Function SetUserInteraction(newUI As API_UserInteraction)
|
||||
Set g_UI = newUI
|
||||
End Function
|
||||
|
||||
Public Function UIShowMessage(theCode As MsgCode, ParamArray params() As Variant)
|
||||
Dim unwrapped As Variant: unwrapped = params
|
||||
unwrapped = FixForwardedParams(unwrapped)
|
||||
|
||||
Select Case theCode
|
||||
Case EM_HYPERLINK_CREATION_FAIL: Call MsgBox("Ïðè äîáàâëåíèè çàêëàäêè ïðîèçîøëà îøèáêà. Îáðàòèòåñü ê ðàçðàáîò÷èêó", vbExclamation)
|
||||
Case EM_HYPERLINKS_MISSING: Call MsgBox("Â äîêóìåíòå îòñóòñòâóþò ññûëêè", vbInformation)
|
||||
Case EM_DOCUMENT_NOT_SAVED: Call MsgBox("Äîêóìåíò íå áûë ñîõðàí¸í" & vbNewLine & "Ñîõðàíèòå äîêóìåíò è ïîâòîðèòå ïîïûòêó", vbCritical)
|
||||
Case EM_SELECTION_EMPTY: Call MsgBox("Âûäåëåíèå ïóñòî. Âûäåëèòå ôðàãìåíò òåêñòà", vbExclamation)
|
||||
Case EM_MISSING_FILE: Call MsgBox(Fmt("Îòñóòñòâóåò äîñòóï ê ôàéëó: {1}", unwrapped), vbExclamation)
|
||||
Case EM_CORE_UPDATE_FAILED: Call MsgBox("Íå óäàëîñü óñòàíîâèòü ôàéëû ÊÎÍÖÅÏÒ ñ ñåðâåðà." & vbNewLine _
|
||||
& "Ïðîâåðüòå VPN, ñåòåâûå ïóòè (\\fs1.concept.ru)" & vbNewLine _
|
||||
& "Ïîïðîáóéòå ïåðåçàãðóçèòü Excel äëÿ âûãðóçêè dll", vbExclamation)
|
||||
|
||||
Case IM_REMOVE_HYPERLINKS_OK: Call MsgBox(Fmt("Ãèïåðññûëêè óäàëåíû: {1}", unwrapped), vbInformation)
|
||||
Case IM_REMOVE_BOOKMARKS_OK: Call MsgBox(Fmt("Çàêëàäêè óäàëåíû: {1}", unwrapped), vbInformation)
|
||||
Case IM_REMOVE_IMAGES_OK: Call MsgBox(Fmt("Êàðòèíêè óäàëåíû: {1}", unwrapped), vbInformation)
|
||||
Case IM_SHAPES_TO_TEXT_OK: Call MsgBox("Ïðåîáðàçîâàíèå óñïåøíî çàâåðøåíî", vbInformation)
|
||||
Case IM_CONVERT_CODEPAGE_OK: Call MsgBox("Êîððåêòèðîâêà âûïîëíåíà", vbInformation)
|
||||
Case IM_UNIQUE_BOOKMARKS_OK: Call MsgBox("Ïåðåñîçäàíèå çàêëàäîê çàâåðøåíî", vbInformation)
|
||||
Case IM_REMOVE_ACCENTS_OK: Call MsgBox(Fmt("Óäàëåíû óäàðåíèÿ: {1}", unwrapped), vbInformation)
|
||||
Case IM_CONCEPT_UPDATE_OK: Call MsgBox("Îôèñíûå ïðîäóêòû ÊÎÍÖÅÏÒ îáíîâëåíû óñïåøíî", vbInformation)
|
||||
Case IM_COMMENT_EXPORT_OK: Call MsgBox(Fmt("Âûãðóæåíî ïðèìå÷àíèé: {1}", unwrapped), vbInformation)
|
||||
Case IM_BOOKMARK_IGNORED:
|
||||
Call MsgBox(Fmt("Âûäåëåííàÿ îáëàñòü äîáàâëåíà â èãíîðèðóåìûå" & vbNewLine & _
|
||||
"×òîáû îòìåíèòü äåéñòâèå íåîáõîäèìî óäàëèòü çàêëàäêó {1}", unwrapped), vbInformation)
|
||||
Case IM_HYPERLINKS_FIX_OK:
|
||||
Call MsgBox(Fmt("Îáðàáîòàíî ññûëîê: {1}" & vbNewLine & _
|
||||
"Íàéäåíî íåêîððåêòíûõ: {2}" & vbNewLine & _
|
||||
"Èñïðàâëåíî: {3}", unwrapped), vbInformation)
|
||||
Case IM_RULES_COMPLETE
|
||||
Call MsgBox(Fmt("Âðåìÿ âûïîëíåíèÿ: {1} ms" & vbNewLine & vbNewLine & _
|
||||
"Íàéäåíî îøèáîê: {2}" & vbNewLine & _
|
||||
"Âíåñåíî ïðàâîê: {3}", unwrapped), vbInformation)
|
||||
|
||||
Case Else: Call MsgBox("Íåâåðíûé êîä ñîîáùåíèÿ", vbCritical)
|
||||
End Select
|
||||
End Function
|
||||
|
||||
Public Function UIAskQuestion(theCode As MsgCode, ParamArray params() As Variant) As Boolean
|
||||
Dim unwrapped As Variant: unwrapped = params
|
||||
unwrapped = FixForwardedParams(unwrapped)
|
||||
|
||||
Dim answer&: answer = vbNo
|
||||
Select Case theCode
|
||||
' Case QM_CODE_DELETE_CONFIRM
|
||||
' answer = MsgBox("Are you sure you want to delete ALL macros from target file?", 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 Explicit
|
||||
|
||||
Sub CC_OnRibbonBtn(iControl As IRibbonControl)
|
||||
Select Case iControl.ID
|
||||
Case "CheckLinks": Call CC_CheckLinks
|
||||
Case "AddQuote": Call CC_AddQuote
|
||||
Case "EditCut": Call CC_EditCut
|
||||
Case "EditCopy": Call CC_EditCopy
|
||||
Case "CreateLink": Call CC_CreateHLink
|
||||
|
||||
Case "FixParagraph": Call CC_ParFix
|
||||
Case "ExportComments": Call CC_ExportComments
|
||||
Case "RemoveExternalHyperlinks": Call CC_RemoveExternalHyperlinks
|
||||
Case "RemoveAllHyperlinks": Call CC_RemoveAllHyperlinks
|
||||
Case "RemoveImages": Call CC_RemoveImages
|
||||
Case "RemoveBookmarks": Call CC_RemoveBookmarks
|
||||
Case "RemoveAccents": Call CC_RemoveAccents
|
||||
|
||||
Case "MasterText": Call CC_MasterText
|
||||
Case "UpdateConcept": Call CC_UpdateConcept
|
||||
|
||||
Case "Help": Call CC_Help
|
||||
|
||||
Case "Checkup": Call CC_Checkup
|
||||
Case "FixErrors": Call CC_FixErrors
|
||||
Case "IgnoreSelected": Call CC_IgnoreSelected
|
||||
Case "MasterConfig": Call CC_MasterConfig
|
||||
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="word/document.xml"/><Relationship Id="rId6" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/><Relationship Id="rId5" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/><Relationship Id="rId4" Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="customUI/customUI.xml"/></Relationships>
|
||||
101
ui/customUI.xml
Normal file
101
ui/customUI.xml
Normal file
|
|
@ -0,0 +1,101 @@
|
|||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" xmlns:CC="CONCEPT">
|
||||
<ribbon startFromScratch="false">
|
||||
<tabs>
|
||||
<tab idQ="CC:Concept" label="КОНЦЕПТ">
|
||||
<group id="BasicFunctions" label="Основные" imageMso="FileCompactAndRepairDatabase">
|
||||
<button id="AddQuote"
|
||||
label="Закавычить"
|
||||
supertip="Выделить кавычками выбранный фрагмент [Ctrl+Shift+']"
|
||||
imageMso="NumberInsert"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="EditCut"
|
||||
label="Вырезать"
|
||||
supertip="Вырезать и вставить выбранный фрагмент тексте в конец документа [Ctrl+{]"
|
||||
imageMso="SignatureInsertMenu"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="EditCopy"
|
||||
label="Копировать"
|
||||
supertip="Копировать и вставить выбранный фрагмент тексте в конец документа [Ctrl+}]"
|
||||
imageMso="FileViewDigitalSignatures"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CreateLink" size="large"
|
||||
label="Создать ссылку"
|
||||
supertip="Создает ссылку на выделенный фрагмент в буфере обмена"
|
||||
imageMso="AdvertisePublishAs"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
|
||||
<menu id="EditMenu" label="Edit" imageMso="EditDocument" size="large">
|
||||
<button id="FixParagraph" label="Подгон абзацев [Ctrl+Shift+R]"
|
||||
imageMso="AnimationTriggerAddMenu"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="ExportComments" label="Выгрузить примечания"
|
||||
imageMso="Export"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="RemoveExternalHyperlinks" label="Удалить внешние гиперссылки"
|
||||
imageMso="HyperlinksRemove"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="RemoveAllHyperlinks" label="Удалить все гиперссылки"
|
||||
imageMso="HyperlinkRemove"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="RemoveImages" label="Удалить картинки"
|
||||
imageMso="WebControlSubmitWithImage"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="RemoveBookmarks" label="Удалить закладки"
|
||||
imageMso="VideoBookmarkRemove"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="RemoveAccents" label="Удалить ударения"
|
||||
imageMso="EquationAccentGallery"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="CheckLinks" label="Исправить ссылки на сервер"
|
||||
imageMso="FileServerLinkTables"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
</menu>
|
||||
|
||||
<separator id="sepMT"/>
|
||||
|
||||
<button id="UpdateConcept" size="large"
|
||||
label="Обновить CONCEPT"
|
||||
supertip="Обновление всех технологий, входящих в состав офисных продуктов КОНЦЕПТ, включая шаблоны документов"
|
||||
imageMso="DesignerRibbonGiveFeedback"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="Help" size="large"
|
||||
label="Справка"
|
||||
supertip="Вызов справки по надстройкам Word"
|
||||
imageMso="Info"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
|
||||
</group>
|
||||
|
||||
<group id="MasterTextGroup" label="Мастер текстов">
|
||||
<button id="Checkup" size="large"
|
||||
label="Проверить"
|
||||
supertip="Выделить проблемы в текущем документе"
|
||||
imageMso="UpdateBibliography"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="FixErrors" size="large"
|
||||
label="Исправить ошибки"
|
||||
supertip="Исправить проблемы в текущем документе"
|
||||
imageMso="TouchTriageFollowUp_Completed"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="IgnoreSelected" size="large"
|
||||
label="Игнорировать"
|
||||
supertip="Игнорировать выделенный фрагмент при проверке"
|
||||
imageMso="IgnoreThisIssue"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
<button id="MasterConfig" size="large"
|
||||
label="Конфигурация"
|
||||
supertip="Открыть конфигурацию правил проверки"
|
||||
imageMso="BulletListDefault"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
|
||||
<button id="MasterText" size="large"
|
||||
label="Мастер Текстов"
|
||||
supertip="Использовать текущий файл для проверки полнофункциональным Мастером Текстов"
|
||||
imageMso="BlogPublish"
|
||||
onAction="CC_OnRibbonBtn"/>
|
||||
</group>
|
||||
</tab>
|
||||
</tabs>
|
||||
</ribbon>
|
||||
</customUI>
|
||||
2
ui/customizations.xml
Normal file
2
ui/customizations.xml
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
|
||||
<wne:tcg xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships" xmlns:wne="http://schemas.microsoft.com/office/word/2006/wordml"><wne:keymaps><wne:keymap wne:kcmPrimary="0226"><wne:macro wne:macroName="CONCEPTAI.MAIN.CC_LINEUP"/></wne:keymap><wne:keymap wne:kcmPrimary="0228"><wne:macro wne:macroName="CONCEPTAI.MAIN.CC_LINEDOWN"/></wne:keymap><wne:keymap wne:kcmPrimary="0231"><wne:macro wne:macroName="CONCEPTAI.MAIN.CC_NONBREAKPAR"/></wne:keymap><wne:keymap wne:kcmPrimary="0232"><wne:macro wne:macroName="CONCEPTAI.MAIN.CC_ADDCOLUMNBREAK"/></wne:keymap><wne:keymap wne:kcmPrimary="0233"><wne:macro wne:macroName="CONCEPTAI.MAIN.CC_WITHNEXT"/></wne:keymap><wne:keymap wne:kcmPrimary="0326"><wne:macro wne:macroName="CONCEPTAI.MAIN.CC_LINEUPA"/></wne:keymap><wne:keymap wne:kcmPrimary="0328"><wne:macro wne:macroName="CONCEPTAI.MAIN.CC_LINEDOWNA"/></wne:keymap><wne:keymap wne:kcmPrimary="0352"><wne:macro wne:macroName="CONCEPTAI.MAIN.CC_PARFIX"/></wne:keymap><wne:keymap wne:kcmPrimary="03DB"><wne:macro wne:macroName="CONCEPTAI.MAIN.CC_EDITCUT"/></wne:keymap><wne:keymap wne:kcmPrimary="03DD"><wne:macro wne:macroName="CONCEPTAI.MAIN.CC_EDITCOPY"/></wne:keymap><wne:keymap wne:kcmPrimary="03DE"><wne:macro wne:macroName="CONCEPTAI.MAIN.CC_ADDQUOTE"/></wne:keymap></wne:keymaps><wne:toolbars><wne:toolbarData r:id="rId1"/></wne:toolbars></wne:tcg>
|
||||
Loading…
Reference in New Issue
Block a user