Initial commit
This commit is contained in:
IRBorisov
commit
2c8b91e305
35
VBAMake.txt
Normal file
35
VBAMake.txt
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
# == Properties Section ==
|
||||
# configuration properties
|
||||
# use .ini format to define properties
|
||||
# mandatory properties: name, artifact_home, source_home
|
||||
|
||||
id = Concept-Maket
|
||||
name = Концепт-Макетирование
|
||||
description = Надстройка КОНЦЕПТ для макетирования отчетов
|
||||
artifact_home = Концепт-Макетирование
|
||||
source_home = Concept-Maket
|
||||
install_home = \\fs1.concept.ru\projects\10 Автоматизация деятельности\02 Офисная автоматизация\81 Макетирование
|
||||
|
||||
%%
|
||||
# === 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\!Руководство пользователя.docx
|
||||
|
||||
%%
|
||||
# === Install section ==
|
||||
# Available commands:
|
||||
# install LOCAL_ARTIFACT -> [INSTALL_PATH]
|
||||
# add_template LOCAL_ARTIFACT -> [LOCAL_TEMPLATE]
|
||||
# run LOCAL_ARTIFACT.bat <- [PARAMETERS]
|
||||
# run APPLICATION <- [PARAMETERS]
|
||||
|
||||
install _Maket.dotm
|
||||
install _Maket.dotm -> \\fs1.concept.ru\Exchange\ConceptDistr\data\Add-ins\Word\_Maket.dotm
|
||||
|
||||
install !Руководство пользователя.docx
|
||||
BIN
distr/!Руководство пользователя.docx
Normal file
BIN
distr/!Руководство пользователя.docx
Normal file
Binary file not shown.
97
script/manifest.txt
Normal file
97
script/manifest.txt
Normal file
|
|
@ -0,0 +1,97 @@
|
|||
# == Properties Section ==
|
||||
# configuration properties
|
||||
# use .ini format to define properties
|
||||
# mandatory properties: name, artifact
|
||||
|
||||
name = _Maket.dotm
|
||||
artifact = _Maket.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
|
||||
z_PastePictureAPI.bas
|
||||
z_LoadPictureAPI.bas
|
||||
ex_WinAPI.bas
|
||||
API_WordWrapper.cls
|
||||
API_XLWrapper.cls
|
||||
API_UserInteraction.cls
|
||||
|
||||
utility
|
||||
ex_VBA.bas
|
||||
ex_Collection.bas
|
||||
ex_Color.bas
|
||||
|
||||
word
|
||||
ex_Word.bas
|
||||
|
||||
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
|
||||
|
||||
CD_Audit.bas
|
||||
CD_AutoDesign.bas
|
||||
CD_Colontitles.bas
|
||||
CD_Layout.bas
|
||||
CD_Paint.bas
|
||||
CD_RedesignFonts.bas
|
||||
CD_SplitTable.bas
|
||||
CD_WordModule.bas
|
||||
|
||||
IconPicker.cls
|
||||
|
||||
ItemFontScale.cls
|
||||
ItemChapter.cls
|
||||
ItemColontitles.cls
|
||||
|
||||
InfoDocument.cls
|
||||
|
||||
dialogs
|
||||
CDD_AddPict.frm
|
||||
CDD_AutoDesign.frm
|
||||
CDD_FontScaling.frm
|
||||
CDD_HeaderFooter.frm
|
||||
CDD_Paint.frm
|
||||
CDD_RunAudit.frm
|
||||
CDD_TableColors.frm
|
||||
CDD_TablePrototype.frm
|
||||
|
||||
%%
|
||||
# ===== 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 : Shell32
|
||||
global : Scripting
|
||||
global : Excel
|
||||
global : MSForms
|
||||
BIN
skeleton/_Maket.dotm
Normal file
BIN
skeleton/_Maket.dotm
Normal file
Binary file not shown.
288
src/CD_Audit.bas
Normal file
288
src/CD_Audit.bas
Normal file
|
|
@ -0,0 +1,288 @@
|
|||
Attribute VB_Name = "CD_Audit"
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Private Const RUN_HEADER_RUN$ = "Áåãàþùèé çàãîëîâîê"
|
||||
Private Const DANG_SPACES$ = "Ïðîâåðüòå îòñòóïû"
|
||||
Private Const DANG_DASH$ = "Òèðå/äåôèñ â íà÷àëå/êîíöå ñòðîêè"
|
||||
Private Const DANG_FLD$ = "Íåðàáî÷åå ïîëå"
|
||||
Private Const DANG_LISTNUM$ = "Ïðîâåðüòå íóìåðàöèþ ñïèñêà"
|
||||
Private Const DANG_PICT$ = "Ïðîâåðüòå ïîëîæåíèå ïèêòîãðàììû"
|
||||
|
||||
Public Sub CDA_Audit()
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
Call CDD_RunAudit.Init
|
||||
Call CDD_RunAudit.Show
|
||||
If CDD_RunAudit.isCancelled_ Or CDD_RunAudit.CountRules = 0 Then _
|
||||
Exit Sub
|
||||
|
||||
Call CSE_ProgressBar.Init("Ïðîâåðêà ìàêåòà", maxVal:=CDD_RunAudit.CountRules)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
Dim sMessage$
|
||||
If CDD_RunAudit.DoHeaders Then _
|
||||
sMessage = sMessage & "Áåãàþùèõ çàãîëîâêîâ íàéäåíî: " & CheckHeaders(theDoc) & vbNewLine
|
||||
If CDD_RunAudit.DoPar Then _
|
||||
sMessage = sMessage & "Íåêîððåòíûõ îòñòóïîâ íàéäåíî: " & CheckSpaces(theDoc) & vbNewLine
|
||||
If CDD_RunAudit.DoDash Then _
|
||||
sMessage = sMessage & "Îìåðçèòåëüíûõ òèðå íàéäåíî: " & CheckDashes(theDoc) & vbNewLine
|
||||
If CDD_RunAudit.DoFields Then _
|
||||
sMessage = sMessage & "Íåðàáî÷èõ ïîëåé íàéäåíî: " & CheckFields(theDoc) & vbNewLine
|
||||
If CDD_RunAudit.DoListNums Then _
|
||||
sMessage = sMessage & "Ðàçíóìåðîâàííûõ ñïèñêîâ íàéäåíî:" & CheckNumerList(theDoc) & vbNewLine
|
||||
If CDD_RunAudit.DoPict Then _
|
||||
sMessage = sMessage & "Îïàñíûõ ïèêòîãðàìì íàéäåíî:" & CheckPict(theDoc) & vbNewLine
|
||||
|
||||
Call Unload(CDD_RunAudit)
|
||||
Call Unload(CSE_ProgressBar)
|
||||
Call MsgBox(sMessage, vbInformation)
|
||||
End Sub
|
||||
|
||||
' ===========
|
||||
Private Function CheckNumerList(target As Word.Document) As Long
|
||||
CSE_ProgressBar.Header = "Íóìåðîâàííûå ñïèñêè..."
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.ListParagraphs.Count)
|
||||
|
||||
Dim para As Word.Paragraph
|
||||
For Each para In target.ListParagraphs
|
||||
Dim theRange As Word.Range: Set theRange = para.Range
|
||||
If Not theRange.ListFormat.ListString Like "*#*" Or IsHeader(theRange) Then _
|
||||
GoTo NEXT_PARA
|
||||
|
||||
Dim theLvl&: theLvl = theRange.ListFormat.ListLevelNumber
|
||||
If InStr(theRange, Chr(7)) Then _
|
||||
GoTo NEXT_PARA
|
||||
|
||||
Dim prevRange As Word.Range: Set prevRange = theRange.Previous(wdParagraph)
|
||||
If CheckPrevRangeList(prevRange, theLvl) Then _
|
||||
GoTo NEXT_PARA
|
||||
|
||||
If theRange.ListFormat.ListValue <> 1 Then
|
||||
Call theRange.Collapse(wdCollapseStart)
|
||||
Call theRange.Comments.Add(theRange, DANG_LISTNUM)
|
||||
CheckNumerList = CheckNumerList + 1
|
||||
End If
|
||||
|
||||
NEXT_PARA:
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next para
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function CheckPrevRangeList(prevRange As Word.Range, theLvl&) As Boolean
|
||||
CheckPrevRangeList = False
|
||||
|
||||
If prevRange Is Nothing Then _
|
||||
Exit Function
|
||||
If IsHeader(prevRange) Or prevRange.ListFormat.List Is Nothing Then _
|
||||
Exit Function
|
||||
|
||||
CheckPrevRangeList = theLvl <= prevRange.ListFormat.ListLevelNumber
|
||||
End Function
|
||||
|
||||
Private Function CheckHeaders(target As Word.Document) As Long
|
||||
CSE_ProgressBar.Header = "Ïîèñê áåãàþùèõ çàãîëîâêîâ..."
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.Range.End)
|
||||
|
||||
Dim parRng As Word.Range: Set parRng = target.Paragraphs.First.Range
|
||||
Do While Not parRng Is Nothing
|
||||
If Not IsHeader(parRng) Or IsHeader(parRng, 1) Then _
|
||||
GoTo NEXT_PAR
|
||||
|
||||
If IsFirstInColumn(parRng) Then
|
||||
If parRng.ParagraphFormat.SpaceBefore <> 0 Then
|
||||
Call parRng.Comments.Add(parRng, RUN_HEADER_RUN)
|
||||
CheckHeaders = CheckHeaders + 1
|
||||
End If
|
||||
ElseIf parRng.ParagraphFormat.SpaceBefore <> 0 Then
|
||||
GoTo NEXT_PAR
|
||||
ElseIf Not IsHeader(parRng.Previous(wdParagraph)) Then
|
||||
Call parRng.Comments.Add(parRng, RUN_HEADER_RUN)
|
||||
CheckHeaders = CheckHeaders + 1
|
||||
End If
|
||||
NEXT_PAR:
|
||||
Call CSE_ProgressBar.SetB(parRng.End)
|
||||
Set parRng = parRng.Next(wdParagraph, 1)
|
||||
Loop
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function CheckSpaces(target As Word.Document) As Long
|
||||
CSE_ProgressBar.Header = "Ïðîâåðêà îòñòóïîâ..."
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.Range.End)
|
||||
|
||||
Dim parRng As Word.Range: Set parRng = target.Paragraphs.First.Range
|
||||
Do While Not parRng Is Nothing
|
||||
If Not IsHeader(parRng) Or IsHeader(parRng, 1) Then _
|
||||
GoTo NEXT_PAR
|
||||
If IsFirstInColumn(parRng) Then _
|
||||
GoTo NEXT_PAR
|
||||
|
||||
Dim tmpRng As Word.Range: Set tmpRng = parRng.Previous(wdParagraph)
|
||||
'çàãîë âïðèòûê ê ïðåä
|
||||
If IsHeader(tmpRng) And tmpRng.ParagraphFormat.SpaceAfter = 0 Then
|
||||
Call parRng.Comments.Add(parRng, DANG_SPACES)
|
||||
CheckSpaces = CheckSpaces + 1
|
||||
End If
|
||||
|
||||
'ïåðåä çàãîë ?ðàìêà?
|
||||
If Not IsHeader(tmpRng) And tmpRng.ParagraphFormat.SpaceAfter <> 0 Then
|
||||
If tmpRng.ListFormat.List Is Nothing Then
|
||||
Call parRng.Comments.Add(parRng, DANG_SPACES)
|
||||
CheckSpaces = CheckSpaces + 1
|
||||
End If
|
||||
End If
|
||||
|
||||
' ïîñëå çàãîë ?ðàìêà?
|
||||
Set tmpRng = parRng.Next(wdParagraph)
|
||||
If tmpRng.ParagraphFormat.SpaceBefore <> 0 Then
|
||||
Call parRng.Comments.Add(parRng, DANG_SPACES)
|
||||
CheckSpaces = CheckSpaces + 1
|
||||
End If
|
||||
NEXT_PAR:
|
||||
Call CSE_ProgressBar.SetB(parRng.End)
|
||||
Set parRng = parRng.Next(wdParagraph, 1)
|
||||
Loop
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function CheckPict(target As Word.Document) As Long
|
||||
CSE_ProgressBar.Header = "Ïîèñê îïàñíûõ ïèêòîãðàìì..."
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.Shapes.Count)
|
||||
|
||||
Dim aShape As Word.Shape
|
||||
For Each aShape In target.Shapes
|
||||
If aShape.Type = msoTextBox Then
|
||||
If GetColumn(aShape.Anchor) = T_COL_RIGHT And IsFirstInColumn(aShape.Anchor) Then
|
||||
Call aShape.Anchor.Comments.Add(aShape.Anchor, DANG_PICT)
|
||||
CheckPict = CheckPict + 1
|
||||
End If
|
||||
End If
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next aShape
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function CheckDashes(target As Word.Document) As Long
|
||||
CSE_ProgressBar.Header = "Ïðîâåðêà ïîëîæåíèÿ äåôèñîâ..."
|
||||
Call CSE_ProgressBar.InitSecondBar(0, 3)
|
||||
|
||||
Dim rFind As Word.Range: Set rFind = target.Range.Duplicate
|
||||
Dim tempRange As Word.Range
|
||||
With rFind.Find
|
||||
.Text = Chr(45)
|
||||
Do While .Execute
|
||||
Set tempRange = rFind.Duplicate
|
||||
Call tempRange.Collapse(wdCollapseStart)
|
||||
Call tempRange.Select
|
||||
If PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) < 0.1 And _
|
||||
rFind.Comments.Count = 0 And rFind.Hyperlinks.Count = 0 And Not IsHeader(rFind) Then
|
||||
Call rFind.Comments.Add(rFind, DANG_DASH)
|
||||
CheckDashes = CheckDashes + 1
|
||||
GoTo skp1
|
||||
End If
|
||||
|
||||
Set tempRange = rFind.Duplicate
|
||||
Call tempRange.Collapse(wdCollapseEnd)
|
||||
Call tempRange.Select
|
||||
If (PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) < 0.1 Or _
|
||||
PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) > 7.4) And _
|
||||
rFind.Comments.Count = 0 And rFind.Hyperlinks.Count = 0 And Not IsHeader(rFind) Then
|
||||
Call rFind.Comments.Add(rFind, DANG_DASH)
|
||||
CheckDashes = CheckDashes + 1
|
||||
End If
|
||||
skp1:
|
||||
Loop
|
||||
End With
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
|
||||
Set rFind = target.Range.Duplicate
|
||||
With rFind.Find
|
||||
.Text = Chr(150)
|
||||
Do While .Execute
|
||||
Set tempRange = rFind.Duplicate
|
||||
Call tempRange.Collapse(wdCollapseStart)
|
||||
Call tempRange.Select
|
||||
If PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) < 0.1 And _
|
||||
rFind.Comments.Count = 0 And rFind.Hyperlinks.Count = 0 And Not IsHeader(rFind) Then
|
||||
Call rFind.Comments.Add(rFind, DANG_DASH)
|
||||
CheckDashes = CheckDashes + 1
|
||||
GoTo skp2
|
||||
End If
|
||||
|
||||
Set tempRange = rFind.Duplicate
|
||||
Call tempRange.Collapse(wdCollapseEnd)
|
||||
Call tempRange.Select
|
||||
If (PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) < 0.1 Or _
|
||||
PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) > 7.4) And _
|
||||
rFind.Comments.Count = 0 And rFind.Hyperlinks.Count = 0 And Not IsHeader(rFind) Then
|
||||
Call rFind.Comments.Add(rFind, DANG_DASH)
|
||||
CheckDashes = CheckDashes + 1
|
||||
End If
|
||||
skp2:
|
||||
Loop
|
||||
End With
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
|
||||
Set rFind = target.Range.Duplicate
|
||||
With rFind.Find
|
||||
.Text = Chr(151)
|
||||
Do While .Execute
|
||||
Set tempRange = rFind.Duplicate
|
||||
Call tempRange.Collapse(wdCollapseStart)
|
||||
Call tempRange.Select
|
||||
If PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) < 0.1 And _
|
||||
rFind.Comments.Count = 0 And rFind.Hyperlinks.Count = 0 And Not IsHeader(rFind) Then
|
||||
Call rFind.Comments.Add(rFind, DANG_DASH)
|
||||
CheckDashes = CheckDashes + 1
|
||||
GoTo skp3
|
||||
End If
|
||||
|
||||
Set tempRange = rFind.Duplicate
|
||||
Call tempRange.Collapse(wdCollapseEnd)
|
||||
Call tempRange.Select
|
||||
If (PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) < 0.1 Or _
|
||||
PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) > 7.4) And _
|
||||
rFind.Comments.Count = 0 And rFind.Hyperlinks.Count = 0 And Not IsHeader(rFind) Then
|
||||
Call rFind.Comments.Add(rFind, DANG_DASH)
|
||||
CheckDashes = CheckDashes + 1
|
||||
End If
|
||||
skp3:
|
||||
Loop
|
||||
End With
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function CheckFields(target As Word.Document) As Long
|
||||
Dim tmp As Boolean: tmp = target.TrackRevisions
|
||||
target.TrackRevisions = False
|
||||
|
||||
CSE_ProgressBar.Header = "Ïîèñê íåðàáî÷èõ ïîëåé..."
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.Fields.Count)
|
||||
|
||||
Dim aField As Word.Field
|
||||
For Each aField In target.Fields
|
||||
If aField.Update = False Then
|
||||
If aField.result.Font.Hidden = False Then
|
||||
CheckFields = CheckFields + 1
|
||||
Call aField.result.Comments.Add(aField.result, DANG_FLD)
|
||||
End If
|
||||
End If
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next aField
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
|
||||
target.TrackRevisions = tmp
|
||||
End Function
|
||||
691
src/CD_AutoDesign.bas
Normal file
691
src/CD_AutoDesign.bas
Normal file
|
|
@ -0,0 +1,691 @@
|
|||
Attribute VB_Name = "CD_AutoDesign"
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Private Const HEADS_UNQ_PREF = " _MKT_DLT_HEAD_"
|
||||
Private Const LISTS_STARTS = " _MKT_DLT_LIST_"
|
||||
|
||||
Private Const TABLE_WIDTH_LIMIT As Double = 8
|
||||
Private Const TABLE_HEADER_STYLE = "Íàçâàíèå òàáëèöû"
|
||||
|
||||
Private Const STYLE_CONTRACT = "ß_Òèòóë Çàêàç÷èêè"
|
||||
Private Const STYLE_THEME = "ß_Òèòóë Îò÷åò î âûïîëíåíèè ðàáîò"
|
||||
Private Const STYLE_REQUIREMENTS = "ß_Òèòóë Ëèñò Ñîîòâåòñòâèÿ"
|
||||
|
||||
Public Function RunAutoDesign(prefs As AutoDesignOptions)
|
||||
Dim source As Word.Document: Set source = ActiveDocument
|
||||
|
||||
Call CSE_ProgressBar.Init("Ïåðåâîä â ìàêåò", maxVal:=11 + prefs.Count)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
Dim proxyCount&: proxyCount = ADS_PrepareSource(source)
|
||||
Dim target As Word.Document: Set target = ADS_CreateTarget
|
||||
|
||||
Dim chapters As Collection: Set chapters = ADS_GenerateSections(target, source)
|
||||
Dim listStyles As Collection: Set listStyles = ADS_FillSections(target, source, chapters)
|
||||
|
||||
Call ADS_SetPageSettings(target)
|
||||
|
||||
If prefs.fixObjects Then _
|
||||
Call ADS_TablesAndInlines(target)
|
||||
If prefs.reapplyLists Then _
|
||||
Call ADS_ReapplyStyles(target, listStyles)
|
||||
|
||||
Call ADS_FormatHeaders(target, source, proxyCount)
|
||||
|
||||
If prefs.titlePage Then _
|
||||
Call ADS_TitlePage(target, source)
|
||||
If prefs.generateColontitles Then _
|
||||
Call ADS_Colontitles(target)
|
||||
|
||||
If prefs.doLayout Then _
|
||||
Call ADS_TextLayout(target)
|
||||
|
||||
Call ADS_UpdateToc(target)
|
||||
Call ADS_Paint(target)
|
||||
|
||||
Call ADS_Finalize(target)
|
||||
|
||||
Unload CSE_ProgressBar
|
||||
End Function
|
||||
|
||||
' ==============
|
||||
Private Function ADS_UpdateToc(target As Word.Document)
|
||||
CSE_ProgressBar.Header = "Ôîðìèðîâàíèå îãëàâëåíèÿ..."
|
||||
Dim toc As Word.TableOfContents
|
||||
For Each toc In target.TablesOfContents
|
||||
Call UpdateTableOfContents(toc)
|
||||
Next toc
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function ADS_Paint(target As Word.Document)
|
||||
Call RepaintText(target)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
|
||||
Call RepaintTextShapes(target)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
|
||||
Call RepaintToC(target)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
|
||||
Call RepaintHLinks(target)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function ADS_PrepareSource(source As Word.Document) As Long
|
||||
CSE_ProgressBar.Header = "Ïîäãîòîâêà èñõîäíîãî äîêóìåíòà..."
|
||||
ADS_PrepareSource = MarkListItems(source)
|
||||
Call MarkListsBegin(source)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function ADS_CreateTarget() As Word.Document
|
||||
CSE_ProgressBar.Header = "Ñîçäàíèå äîêóìåíòà..."
|
||||
|
||||
Dim wrapper As New API_WordWrapper
|
||||
Dim target As Word.Document: Set target = wrapper.NewDocument("20 Ìàêåò", False)
|
||||
target.AttachedTemplate = ""
|
||||
target.UpdateStylesOnOpen = False
|
||||
|
||||
Call RemoveSampleSections(target)
|
||||
|
||||
Set ADS_CreateTarget = target
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function ADS_GenerateSections(target As Word.Document, source As Word.Document) As Collection
|
||||
CSE_ProgressBar.Header = "Ñîçäàíèå ãëàâ..."
|
||||
Dim chapters As Collection: Set chapters = ScanChaptersInfo(source)
|
||||
Dim intro As Word.Range: Set intro = target.Range(target.Sections(4).Range.Start, target.Sections(6).Range.End)
|
||||
Call CopyPasteRepeat(intro, target.Sections(7).Range.Start, target, chapters.Count - 1)
|
||||
|
||||
Call TransferChapterHeaders(chapters, target)
|
||||
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
Set ADS_GenerateSections = chapters
|
||||
End Function
|
||||
|
||||
Private Function ADS_FillSections(target As Word.Document, source As Word.Document, chapters As Collection) As Collection
|
||||
CSE_ProgressBar.Header = "Çàïîëíåíèå ðàçäåëîâ..."
|
||||
|
||||
Dim listStyles As New Collection
|
||||
Dim aStyle As Word.Style
|
||||
For Each aStyle In source.Styles
|
||||
Dim sLocal$: sLocal = aStyle.NameLocal
|
||||
If WordStyleExists(target, sLocal) Then
|
||||
If CheckListStyle(target.Styles(sLocal)) Then
|
||||
Call listStyles.Add(sLocal)
|
||||
End If
|
||||
End If
|
||||
Next aStyle
|
||||
|
||||
Call TransferChapersBody(chapters, source, target)
|
||||
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
Set ADS_FillSections = listStyles
|
||||
End Function
|
||||
|
||||
Private Function ADS_SetPageSettings(target As Word.Document)
|
||||
CSE_ProgressBar.Header = "Ïðîâåðêà ïîëåé ïå÷àòè..."
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.Sections.Count - 3)
|
||||
Dim i&
|
||||
For i = 3 To target.Sections.Count - 1
|
||||
With target.Sections(i).PageSetup
|
||||
.LeftMargin = CentimetersToPoints(FIELD_SIZE_CM)
|
||||
.RightMargin = CentimetersToPoints(FIELD_SIZE_CM)
|
||||
.TopMargin = CentimetersToPoints(FIELD_SIZE_CM)
|
||||
.BottomMargin = CentimetersToPoints(FIELD_SIZE_CM)
|
||||
|
||||
.DifferentFirstPageHeaderFooter = False
|
||||
.HeaderDistance = CentimetersToPoints(1.25)
|
||||
.FooterDistance = CentimetersToPoints(1.25)
|
||||
.OddAndEvenPagesHeaderFooter = False
|
||||
End With
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next i
|
||||
|
||||
target.Footnotes.Location = wdBeneathText
|
||||
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Private Function ADS_TablesAndInlines(target As Word.Document)
|
||||
CSE_ProgressBar.Header = "Îáðàáîòêà âñòàâîê..."
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.InlineShapes.Count + target.Tables.Count)
|
||||
|
||||
Dim iShp As Word.InlineShape
|
||||
For Each iShp In target.InlineShapes
|
||||
Dim rShape As Word.Range: Set rShape = iShp.Range
|
||||
If rShape.PageSetup.TextColumns.Count > 1 Then
|
||||
If rShape.Paragraphs(1).Next.Range.Style = "Íàçâàíèå îáúåêòà" Then
|
||||
Call rShape.MoveEnd(wdParagraph, 2)
|
||||
Call InsertOneColomnSection(rShape)
|
||||
End If
|
||||
End If
|
||||
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next iShp
|
||||
|
||||
Dim aTable As Word.Table
|
||||
For Each aTable In target.Tables
|
||||
Dim rTable As Word.Range: Set rTable = aTable.Range
|
||||
aTable.PreferredWidthType = wdPreferredWidthPoints
|
||||
If rTable.PageSetup.TextColumns.Count > 1 And aTable.PreferredWidth >= CentimetersToPoints(TABLE_WIDTH_LIMIT) Then
|
||||
aTable.PreferredWidthType = wdPreferredWidthPercent
|
||||
aTable.PreferredWidth = 100
|
||||
If rTable.Paragraphs(1).Previous.Range.Style = TABLE_HEADER_STYLE Then
|
||||
Call rTable.MoveStart(wdParagraph, -1)
|
||||
Call InsertOneColomnSection(rTable)
|
||||
End If
|
||||
End If
|
||||
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next aTable
|
||||
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Private Function ADS_ReapplyStyles(target As Word.Document, listStyles As Collection)
|
||||
CSE_ProgressBar.Header = "Ïîâòîðíîå ïðèìåíåíèå ñòèëåé..."
|
||||
|
||||
Call CSE_ProgressBar.InitSecondBar(0, listStyles.Count)
|
||||
Dim aStyle As Variant
|
||||
For Each aStyle In listStyles
|
||||
Call ReApplyStyle(target, CStr(aStyle))
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next aStyle
|
||||
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Private Function ADS_FormatHeaders(target As Word.Document, source As Word.Document, proxyCount&)
|
||||
CSE_ProgressBar.Header = "Ôîðìàòèðîâàíèå çàãîëîâêîâ..."
|
||||
|
||||
Call FinalizeLists(source, True)
|
||||
Call FinalizeLists(target, False)
|
||||
|
||||
Call FixGapsStyle(target)
|
||||
Call TransferHeaderFormats(target, source)
|
||||
|
||||
Call RemoveListPoxy(source, proxyCount)
|
||||
Call RemoveListPoxy(target, proxyCount)
|
||||
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function ADS_TitlePage(target As Word.Document, source As Word.Document)
|
||||
CSE_ProgressBar.Header = "Ïåðåíîñ òèòóëà è ëèñòà ñîîâòåòñòâèÿ..."
|
||||
Call TransferTitlePage(source, target)
|
||||
Call TransferWorkerList(source, target)
|
||||
Call TransferRequirements(source, target)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function ADS_TextLayout(target As Word.Document)
|
||||
CSE_ProgressBar.Header = "Âûðàâíèâàíèå..."
|
||||
Call UpdateListsLayout(target)
|
||||
Call UpdateTextLayout(target)
|
||||
Call UpdateObjectFields(target)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function ADS_Colontitles(target As Word.Document)
|
||||
CSE_ProgressBar.Header = "Ðàññòàíîâêà êîëîíòèòóëîâ..."
|
||||
|
||||
Dim docData As New InfoDocument: Call docData.Init(target)
|
||||
Dim iColons As New ItemColontitles
|
||||
With iColons
|
||||
.mTopLeft = T_SOURCE_VOLUME
|
||||
.mTopRight = T_SOURCE_BOOK
|
||||
.mBottomLeft = T_SOURCE_CONCEPT
|
||||
.mBottomRight = T_SOURCE_SECTION
|
||||
.start_ = 3
|
||||
.finish_ = target.Sections.Count - 1
|
||||
|
||||
.doBottomRight = True
|
||||
.doTopLeft = docData.IsValidNames
|
||||
.doTopRight = .doTopLeft
|
||||
End With
|
||||
|
||||
Call CSE_ProgressBar.InitSecondBar(0, iColons.finish_ - iColons.start_ + 1)
|
||||
Call CreateColontitles(target, docData, iColons, "IncrementB")
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function ADS_Finalize(target As Word.Document)
|
||||
CSE_ProgressBar.Header = "Ôèíàëèçàöèÿ..."
|
||||
Dim i%
|
||||
For i = 3 To target.Sections.Count - 1
|
||||
With target.Sections(i)
|
||||
Dim iComment As Word.Range: Set iComment = target.Range(.Range.Start, .Range.Start)
|
||||
If .PageSetup.Orientation = wdOrientLandscape Then _
|
||||
Call iComment.Comments.Add(iComment, "Âû óâåðåíû â îðèåíòàöèè?")
|
||||
End With
|
||||
Next i
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End Function
|
||||
|
||||
Private Function RemoveSampleSections(target As Word.Document)
|
||||
Do While target.Sections.Count > 7
|
||||
Call target.Sections(target.Sections.Count - 1).Range.Delete
|
||||
Loop
|
||||
End Function
|
||||
|
||||
Private Function FinalizeLists(target As Word.Document, justClear As Boolean)
|
||||
Dim rFind As Word.Range: Set rFind = target.Range
|
||||
rFind.Find.Text = LISTS_STARTS
|
||||
Do While rFind.Find.Execute
|
||||
Call rFind.MoveEnd(wdCharacter, 4)
|
||||
Dim aTemplate As Word.ListTemplate: Set aTemplate = rFind.ListFormat.ListTemplate
|
||||
aTemplate.ListLevels(1).StartAt = CLng(Right(rFind.Text, 4))
|
||||
If Not justClear Then
|
||||
Call rFind.ListFormat.ApplyListTemplate(ListTemplate:=aTemplate, _
|
||||
ContinuePreviousList:=False, _
|
||||
ApplyTo:=wdListApplyToWholeList, _
|
||||
DefaultListBehavior:=wdWord10ListBehavior)
|
||||
End If
|
||||
rFind.Delete
|
||||
Loop
|
||||
End Function
|
||||
|
||||
Private Function MarkListsBegin(target As Word.Document)
|
||||
Dim tmpLst As Word.List, tmpLstRange As Word.Range
|
||||
For Each tmpLst In target.Lists
|
||||
If IsHeader(tmpLst.ListParagraphs(1).Range) Then _
|
||||
GoTo CONT_FOR
|
||||
Set tmpLstRange = tmpLst.ListParagraphs(1).Range
|
||||
|
||||
Call tmpLstRange.MoveEndUntil(Chr(13), wdBackward)
|
||||
Call tmpLstRange.MoveEnd(wdCharacter, -1)
|
||||
|
||||
If Right(tmpLstRange.ListFormat.ListString, 2) Like "#?" Then
|
||||
Call tmpLstRange.InsertAfter(LISTS_STARTS & Format(tmpLstRange.ListFormat.ListValue, "0000"))
|
||||
End If
|
||||
CONT_FOR:
|
||||
Next tmpLst
|
||||
End Function
|
||||
|
||||
Private Function MarkListItems(target As Word.Document) As Long
|
||||
Dim hdNames As New Collection
|
||||
Dim listItem As Word.Paragraph
|
||||
For Each listItem In target.ListParagraphs
|
||||
Dim tmpRng As Word.Range: Set tmpRng = listItem.Range
|
||||
If Not InCollection(tmpRng.Text, hdNames) Then
|
||||
Call hdNames.Add(tmpRng.Text, tmpRng.Text)
|
||||
GoTo NEXT_ITEM
|
||||
End If
|
||||
|
||||
MarkListItems = MarkListItems + 1
|
||||
Call tmpRng.MoveEnd(wdCharacter, -1)
|
||||
Dim sMark$: sMark = HEADS_UNQ_PREF & CStr(MarkListItems)
|
||||
Call tmpRng.InsertAfter(sMark)
|
||||
Call tmpRng.MoveEnd(wdCharacter, 1)
|
||||
NEXT_ITEM:
|
||||
Next listItem
|
||||
End Function
|
||||
|
||||
Private Function RemoveListPoxy(target As Word.Document, proxyCount&)
|
||||
Dim nProxy&
|
||||
For nProxy = 1 To proxyCount Step 1
|
||||
Dim rFind As Word.Range: Set rFind = target.Range
|
||||
With rFind.Find
|
||||
.ClearFormatting
|
||||
.Text = "<" & Mid(HEADS_UNQ_PREF & nProxy, 3) & ">"
|
||||
.MatchWildcards = True
|
||||
|
||||
If .Execute Then
|
||||
Call rFind.MoveStart(wdCharacter, -2)
|
||||
rFind.Delete
|
||||
End If
|
||||
End With
|
||||
Next nProxy
|
||||
End Function
|
||||
|
||||
Private Function CheckListStyle(target As Word.Style) As Boolean
|
||||
CheckListStyle = Not target.NameLocal Like "[Çç]àãîëîâîê*"
|
||||
CheckListStyle = CheckListStyle And _
|
||||
(target.NameLocal Like "*[Ìì]àðê[åè]ð*" Or target.NameLocal Like "*[Íí]óìåð*")
|
||||
End Function
|
||||
|
||||
Private Function TransferWorkerList(source As Word.Document, dest As Word.Document)
|
||||
source.Sections(3).Range.Tables(1).Range.Copy
|
||||
Dim insertPosition&: insertPosition = dest.Sections(2).Range.Tables(1).Range.Start
|
||||
Call dest.Sections(2).Range.Tables(1).Delete
|
||||
Call dest.Range(insertPosition&, insertPosition&).PasteAndFormat(wdUseDestinationStylesRecovery)
|
||||
End Function
|
||||
|
||||
Private Function TransferRequirements(source As Word.Document, dest As Word.Document)
|
||||
If RequirementsPosition(source) = 0 Then _
|
||||
Exit Function
|
||||
If RequirementsPosition(dest) = 0 Then _
|
||||
Exit Function
|
||||
|
||||
Call source.Tables(source.Tables.Count).Range.Copy
|
||||
Call dest.Tables(dest.Tables.Count).Delete
|
||||
Call dest.Paragraphs.Last.Range.Paste
|
||||
End Function
|
||||
|
||||
Private Function TransferChapterHeaders(chapters As Collection, doc As Word.Document)
|
||||
Call CSE_ProgressBar.InitSecondBar(0, chapters.Count)
|
||||
|
||||
Dim ColorIndex&: ColorIndex = 0
|
||||
Dim i&, j&: j = 4
|
||||
For i = 1 To chapters.Count
|
||||
Dim headerText$: headerText$ = chapters(i).text_
|
||||
headerText = Left(headerText$, Len(headerText$) - 1)
|
||||
|
||||
Dim rPaste As Word.Range: Set rPaste = doc.Sections(j).Range.Duplicate
|
||||
Call rPaste.MoveEnd(wdWord, -2)
|
||||
rPaste.Text = headerText$
|
||||
|
||||
Dim clrID As WdThemeColorIndex
|
||||
Select Case (i - 1 - ColorIndex) Mod 7
|
||||
Case 0 To 4: clrID = (i - 1 - ColorIndex) Mod 7 + 5
|
||||
Case 5: clrID = wdThemeColorBackground2
|
||||
Case 6: clrID = wdThemeColorText2
|
||||
End Select
|
||||
|
||||
If InStr(UCase(headerText), "ÂÂÅÄÅÍÈÅ") + InStr(UCase(headerText), "ÇÀÊËÞ×ÅÍÈÅ") <> 0 Then
|
||||
clrID = wdThemeColorAccent1
|
||||
ColorIndex = ColorIndex + 1
|
||||
End If
|
||||
rPaste.Paragraphs.First.Range.Font.Color = DesignTheme(clrID)
|
||||
j = j + 3
|
||||
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next i
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Private Function ReApplyStyle(target As Word.Document, aStyle$)
|
||||
If Not WordStyleExists(target, aStyle) Then _
|
||||
Exit Function
|
||||
|
||||
Dim rFind As Word.Range: Set rFind = target.Range
|
||||
Dim lastEnd&
|
||||
rFind.Find.Style = target.Styles(aStyle)
|
||||
Do While rFind.Find.Execute
|
||||
Dim resetRange As Word.Range: Set resetRange = rFind.Duplicate
|
||||
resetRange.Start = IIf(Len(rFind) < 2, rFind.Start, rFind.End - 1)
|
||||
resetRange.End = IIf(Len(rFind) < 2, rFind.End, rFind.End - 1)
|
||||
resetRange.Style = target.Styles(aStyle)
|
||||
|
||||
Call rFind.Collapse(wdCollapseEnd)
|
||||
If rFind.Start >= target.Range.End - 1 Then _
|
||||
Exit Function
|
||||
If rFind.Start = lastEnd Then _
|
||||
Call rFind.Move(wdCharacter, 1)
|
||||
|
||||
lastEnd = rFind.End
|
||||
Loop
|
||||
End Function
|
||||
|
||||
Private Function ScanChaptersInfo(target As Word.Document) As Collection
|
||||
Dim result As New Collection
|
||||
Dim para As Word.Paragraph
|
||||
For Each para In target.Paragraphs
|
||||
If IsHeader(para.Range, 1) Then
|
||||
Dim info As New ItemChapter
|
||||
info.start_ = para.Range.Start
|
||||
info.finish_ = para.Range.End
|
||||
|
||||
Dim lstStrng$: lstStrng = ""
|
||||
If para.Range.ListParagraphs.Count <> 0 Then _
|
||||
lstStrng = para.Range.ListFormat.ListString
|
||||
|
||||
info.text_ = lstStrng & _
|
||||
IIf(Left(para.Range, 1) = " ", "", _
|
||||
IIf(lstStrng = "", "", " ")) & para.Range
|
||||
Call result.Add(info.Clone)
|
||||
End If
|
||||
Next para
|
||||
Set ScanChaptersInfo = result
|
||||
End Function
|
||||
|
||||
Private Function TransferChapersBody(chapters As Collection, source As Word.Document, dest As Word.Document)
|
||||
Call CSE_ProgressBar.InitSecondBar(0, chapters.Count)
|
||||
|
||||
Dim aChapter As ItemChapter: Set aChapter = chapters(chapters.Count)
|
||||
Dim lastFinish&: lastFinish = RequirementsPosition(source)
|
||||
If aChapter.finish_ <= lastFinish Then
|
||||
Call source.Range(aChapter.finish_, lastFinish).Copy
|
||||
Call dest.Range(dest.Sections(chapters.Count * 3 + 2).Range.Start, dest.Sections(chapters.Count * 3 + 2).Range.Start).Paste
|
||||
End If
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
|
||||
Dim i&
|
||||
For i = chapters.Count - 1 To 1 Step -1
|
||||
If chapters(i).finish_ <> chapters(i + 1).start_ Then
|
||||
Call source.Range(chapters(i).finish_, chapters(i + 1).start_).Copy
|
||||
Call dest.Range(dest.Sections(i * 3 + 2).Range.Start, dest.Sections(i * 3 + 2).Range.Start).Paste
|
||||
End If
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next i
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Private Function TransferHeaderFormats(target As Word.Document, source As Word.Document)
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.ListParagraphs.Count)
|
||||
|
||||
Dim listPrefixes As New Collection: Set listPrefixes = ExtractListPrefixes(source)
|
||||
|
||||
Dim pCurrent As Word.Paragraph
|
||||
For Each pCurrent In target.ListParagraphs
|
||||
Dim rCurrent As Word.Range: Set rCurrent = pCurrent.Range
|
||||
If rCurrent.ParagraphFormat.OutlineLevel <> wdOutlineLevelBodyText Then
|
||||
Dim sPrefix$: sPrefix = listPrefixes(rCurrent.Text)
|
||||
Dim sHeaderText$: sHeaderText = RemoveListPrefix(rCurrent.Text)
|
||||
Call InsertHeader(rCurrent, sPrefix & " " & sHeaderText, rCurrent.ListFormat.ListLevelNumber)
|
||||
End If
|
||||
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next pCurrent
|
||||
|
||||
For Each pCurrent In target.ListParagraphs
|
||||
If pCurrent.Range.ParagraphFormat.OutlineLevel <> wdOutlineLevelBodyText Then _
|
||||
Call pCurrent.Range.Delete
|
||||
Next pCurrent
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Private Function TransferTitlePage(source As Word.Document, target As Word.Document)
|
||||
Dim titleData As TitlePageData: titleData = ExtractTitlePageData(source)
|
||||
|
||||
Call TransferBook(target, titleData)
|
||||
Call TransferVolume(target, titleData)
|
||||
|
||||
If Not titleData.rContract Is Nothing Then _
|
||||
Call TransferContract(target, titleData.rContract)
|
||||
If Not titleData.rCustomer Is Nothing Then _
|
||||
Call TransferCustomer(target, titleData.rCustomer)
|
||||
If Not titleData.rTheme Is Nothing Then _
|
||||
Call TransferTheme(target, titleData.rTheme)
|
||||
End Function
|
||||
|
||||
Private Function CopyPasteRepeat(target As Word.Range, nPos&, doc As Word.Document, nCount&)
|
||||
Call target.Copy
|
||||
Dim i&
|
||||
For i = 1 To nCount
|
||||
Call doc.Range(nPos, nPos).PasteAndFormat(wdFormatOriginalFormatting)
|
||||
Next i
|
||||
End Function
|
||||
|
||||
Private Function ExtractListPrefixes(target As Word.Document) As Collection
|
||||
Dim result As New Collection
|
||||
Dim listItem As Word.Paragraph
|
||||
For Each listItem In target.ListParagraphs
|
||||
If listItem.Range.ParagraphFormat.OutlineLevel <> wdOutlineLevelBodyText Then
|
||||
Call result.Add(listItem.Range.ListFormat.ListString, listItem.Range.Text)
|
||||
End If
|
||||
Next listItem
|
||||
Set ExtractListPrefixes = result
|
||||
End Function
|
||||
|
||||
Private Function RemoveListPrefix(listText$) As String
|
||||
Dim result$: result = listText
|
||||
Do While Asc(Right(result, 1)) <= 32
|
||||
result = Left(result, Len(result) - 1)
|
||||
Loop
|
||||
RemoveListPrefix = result
|
||||
End Function
|
||||
|
||||
Private Function RequirementsPosition(target As Word.Document) As Long
|
||||
RequirementsPosition = target.Range.End
|
||||
Dim rFind As Word.Range: Set rFind = target.Range
|
||||
With rFind.Find
|
||||
.Text = "Ëèñò ñîîòâåòñòâèÿ"
|
||||
.Style = STYLE_REQUIREMENTS
|
||||
If Not .Execute Then _
|
||||
Exit Function
|
||||
End With
|
||||
RequirementsPosition = rFind.Start
|
||||
End Function
|
||||
|
||||
Private Function ExtractTitlePageData(target As Word.Document) As TitlePageData
|
||||
Dim result As TitlePageData
|
||||
|
||||
Dim rFind As Word.Range
|
||||
Set rFind = target.Sections(2).Range
|
||||
rFind.Find.Text = "Êíèãà "
|
||||
rFind.Find.MatchCase = False
|
||||
If rFind.Find.Execute Then
|
||||
Set rFind = rFind.Next(wdWord, 1)
|
||||
result.nBookID = CLng(rFind.Text)
|
||||
|
||||
Call rFind.MoveEndUntil(CSET_SLETTERS & CSET_BLETTERS, wdForward)
|
||||
Call rFind.Collapse(wdCollapseEnd)
|
||||
Call rFind.MoveEndUntil(Chr(13), wdForward)
|
||||
result.sBook = rFind.Text
|
||||
End If
|
||||
|
||||
Set rFind = target.Sections(2).Range
|
||||
rFind.Find.Text = "Òîì "
|
||||
rFind.Find.MatchCase = False
|
||||
If rFind.Find.Execute Then
|
||||
Set rFind = rFind.Next(wdWord, 1)
|
||||
result.nVolumeID = CLng(rFind.Text)
|
||||
|
||||
Call rFind.MoveEndUntil(CSET_SLETTERS & CSET_BLETTERS, wdForward)
|
||||
Call rFind.Collapse(wdCollapseEnd)
|
||||
Call rFind.MoveEndUntil(Chr(13))
|
||||
result.sVolume = rFind.Text
|
||||
End If
|
||||
|
||||
Set rFind = target.Sections(2).Range
|
||||
rFind.Find.Text = "Äîãîâîð "
|
||||
rFind.Find.Style = STYLE_CONTRACT
|
||||
rFind.Find.Format = True
|
||||
If rFind.Find.Execute Then
|
||||
Set result.rContract = rFind.Paragraphs.First.Range.Duplicate
|
||||
End If
|
||||
|
||||
Set rFind = target.Sections(2).Range
|
||||
rFind.Find.Text = "Çàêàç÷èê: "
|
||||
rFind.Find.Style = STYLE_CONTRACT
|
||||
rFind.Find.Format = True
|
||||
If rFind.Find.Execute Then
|
||||
Set result.rCustomer = rFind.Paragraphs.First.Range.Duplicate
|
||||
End If
|
||||
|
||||
Set rFind = target.Sections(2).Range
|
||||
rFind.Find.Style = STYLE_THEME
|
||||
rFind.Find.Format = True
|
||||
If rFind.Find.Execute Then
|
||||
Set result.rTheme = rFind.Paragraphs.First.Range.Duplicate
|
||||
End If
|
||||
|
||||
ExtractTitlePageData = result
|
||||
End Function
|
||||
|
||||
Private Function TransferBook(target As Word.Document, titleData As TitlePageData)
|
||||
Dim rPaste As Word.Range: Set rPaste = target.Sections(1).Range
|
||||
With rPaste.Find
|
||||
.Text = "Êíèãà "
|
||||
.Format = True
|
||||
.MatchCase = False
|
||||
End With
|
||||
|
||||
If Not rPaste.Find.Execute Then _
|
||||
Exit Function
|
||||
Set rPaste = rPaste.Next(wdWord, 1)
|
||||
If titleData.nBookID <> 0 Then _
|
||||
rPaste.Text = titleData.nBookID
|
||||
|
||||
If titleData.sBook = "" Then _
|
||||
Exit Function
|
||||
Call rPaste.MoveEndUntil(CSET_SLETTERS & CSET_BLETTERS, wdForward)
|
||||
Call rPaste.Collapse(wdCollapseEnd)
|
||||
Call rPaste.MoveEndUntil(Chr(13), wdForward)
|
||||
rPaste.Text = titleData.sBook
|
||||
End Function
|
||||
|
||||
Private Function TransferVolume(target As Word.Document, titleData As TitlePageData)
|
||||
Dim rPaste As Word.Range: Set rPaste = target.Sections(1).Range
|
||||
With rPaste.Find
|
||||
.Text = "Òîì "
|
||||
.Format = True
|
||||
.MatchCase = False
|
||||
End With
|
||||
If Not rPaste.Find.Execute Then _
|
||||
Exit Function
|
||||
|
||||
Set rPaste = rPaste.Next(wdWord, 1)
|
||||
If titleData.nVolumeID <> 0 Then _
|
||||
rPaste.Text = titleData.nVolumeID
|
||||
|
||||
If titleData.sVolume = "" Then _
|
||||
Exit Function
|
||||
Call rPaste.MoveEndUntil(CSET_SLETTERS & CSET_BLETTERS, wdForward)
|
||||
Call rPaste.Collapse(wdCollapseEnd)
|
||||
Call rPaste.MoveEndUntil(Chr(13), wdForward)
|
||||
rPaste.Text = titleData.sVolume
|
||||
End Function
|
||||
|
||||
Private Function TransferContract(target As Word.Document, rContract As Word.Range)
|
||||
Dim rPaste As Word.Range: Set rPaste = target.Sections(1).Range
|
||||
With rPaste.Find
|
||||
.Text = "Äîãîâîð "
|
||||
.Format = True
|
||||
.Style = STYLE_CONTRACT
|
||||
End With
|
||||
If Not rPaste.Find.Execute Then _
|
||||
Exit Function
|
||||
|
||||
Call rContract.Copy
|
||||
Call rPaste.Paragraphs.First.Range.PasteAndFormat(wdUseDestinationStylesRecovery)
|
||||
End Function
|
||||
|
||||
Private Function TransferCustomer(target As Word.Document, rCustomer As Word.Range)
|
||||
Dim rPaste As Word.Range: Set rPaste = target.Sections(1).Range
|
||||
With rPaste.Find
|
||||
.Text = "Äîãîâîð "
|
||||
.Format = True
|
||||
.Style = STYLE_CONTRACT
|
||||
End With
|
||||
If Not rPaste.Find.Execute Then _
|
||||
Exit Function
|
||||
|
||||
Call rCustomer.Copy
|
||||
Call rPaste.Paragraphs.First.Range.PasteAndFormat(wdUseDestinationStylesRecovery)
|
||||
End Function
|
||||
|
||||
Private Function TransferTheme(target As Word.Document, rTheme As Word.Range)
|
||||
Dim rPaste As Word.Range: Set rPaste = target.Sections(1).Range
|
||||
With rPaste.Find
|
||||
.Format = True
|
||||
.Style = STYLE_THEME
|
||||
End With
|
||||
If Not rPaste.Find.Execute Then _
|
||||
Exit Function
|
||||
|
||||
Call rTheme.Copy
|
||||
Call rPaste.Paragraphs.First.Range.PasteAndFormat(wdUseDestinationStylesRecovery)
|
||||
End Function
|
||||
270
src/CD_Colontitles.bas
Normal file
270
src/CD_Colontitles.bas
Normal file
|
|
@ -0,0 +1,270 @@
|
|||
Attribute VB_Name = "CD_Colontitles"
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Public Function CreateColontitles(target As Word.Document, docMeta As InfoDocument, _
|
||||
props As ItemColontitles, incrementCallback$)
|
||||
Dim sPrevious$
|
||||
Dim nCurrent&: nCurrent = props.start_
|
||||
Do While nCurrent <= props.finish_
|
||||
Dim aSection As Word.Section: Set aSection = target.Sections(nCurrent)
|
||||
Dim headRange As Word.Range: Set headRange = aSection.Range.Paragraphs.First.Range
|
||||
If Not (IsHeader(headRange, 1) Or IsToCHeader(headRange)) Or VBA.Len(headRange.Text) <= 3 Then
|
||||
Call ResetSection(aSection)
|
||||
GoTo NEXT_SECTION
|
||||
End If
|
||||
|
||||
Call ProcessSection(aSection, docMeta, props, sPrevious, nCurrent = props.start_)
|
||||
|
||||
NEXT_SECTION:
|
||||
nCurrent = nCurrent + 1
|
||||
Call CallByName(CSE_ProgressBar, incrementCallback, VbMethod)
|
||||
Loop
|
||||
End Function
|
||||
|
||||
' ============
|
||||
Private Function ResetSection(aSection As Word.Section)
|
||||
aSection.PageSetup.DifferentFirstPageHeaderFooter = False
|
||||
aSection.PageSetup.OddAndEvenPagesHeaderFooter = True
|
||||
aSection.Headers(wdHeaderFooterPrimary).LinkToPrevious = True
|
||||
aSection.Headers(wdHeaderFooterEvenPages).LinkToPrevious = True
|
||||
aSection.Footers(wdHeaderFooterPrimary).LinkToPrevious = True
|
||||
aSection.Footers(wdHeaderFooterEvenPages).LinkToPrevious = True
|
||||
End Function
|
||||
|
||||
Private Function ScanSection(target As Word.Section, ByRef sPrevious$) As SectionData
|
||||
Dim aData As SectionData
|
||||
|
||||
Dim headRange As Word.Range: Set headRange = target.Range.Paragraphs.First.Range
|
||||
If headRange.Style = "Çàãîëîâîê Ãëàâû" Then
|
||||
Call headRange.MoveEnd(wdWord, -1)
|
||||
aData.sChapter = headRange.Text
|
||||
Else
|
||||
aData.sName = headRange.Text
|
||||
If IsUsualSecName(aData.sName, headRange) Then _
|
||||
aData.sName = "Ðàçäåë " & aData.sName
|
||||
If IsToCHeader(aData.sName) Then _
|
||||
aData.sChapter = aData.sName
|
||||
End If
|
||||
|
||||
aData.bNewChapter = aData.sChapter = sPrevious And Not sPrevious = ""
|
||||
sPrevious = aData.sChapter
|
||||
ScanSection = aData
|
||||
End Function
|
||||
|
||||
Private Function ProcessSection(target As Word.Section, docMeta As InfoDocument, props As ItemColontitles, ByRef sPrevious$, bFrist As Boolean)
|
||||
Dim sData As SectionData: sData = ScanSection(target, sPrevious)
|
||||
Dim cPos As ColontitlePosition
|
||||
|
||||
If props.doTopLeft Then
|
||||
cPos.top_ = True
|
||||
cPos.left_ = True
|
||||
cPos.source_ = props.mTopLeft
|
||||
Call ProcessTitle(target, docMeta, cPos, sData, Not bFrist And DoLink(cPos.source_, sData.bNewChapter))
|
||||
End If
|
||||
|
||||
If props.doTopRight Then
|
||||
cPos.top_ = True
|
||||
cPos.left_ = False
|
||||
cPos.source_ = props.mTopRight
|
||||
Call ProcessTitle(target, docMeta, cPos, sData, Not bFrist And DoLink(cPos.source_, sData.bNewChapter))
|
||||
End If
|
||||
|
||||
If props.doBottomLeft Then
|
||||
cPos.top_ = False
|
||||
cPos.left_ = True
|
||||
cPos.source_ = props.mBottomLeft
|
||||
Call ProcessTitle(target, docMeta, cPos, sData, Not bFrist And DoLink(cPos.source_, sData.bNewChapter))
|
||||
End If
|
||||
|
||||
If props.doBottomRight Then
|
||||
cPos.top_ = False
|
||||
cPos.left_ = False
|
||||
cPos.source_ = props.mBottomRight
|
||||
Call ProcessTitle(target, docMeta, cPos, sData, Not bFrist And DoLink(cPos.source_, sData.bNewChapter))
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function ProcessTitle(target As Word.Section, docMeta As InfoDocument, cPos As ColontitlePosition, sData As SectionData, linkToPrev As Boolean)
|
||||
Dim oTitle As Word.HeaderFooter: Set oTitle = GetHeader(target, cPos)
|
||||
oTitle.LinkToPrevious = linkToPrev
|
||||
If linkToPrev Then _
|
||||
Exit Function
|
||||
|
||||
Call ReplaceColontitle(oTitle, cPos, TitlesText(cPos.source_, sData, docMeta))
|
||||
End Function
|
||||
|
||||
Private Function TitlesText(sMode As TSource, sData As SectionData, docMeta As InfoDocument) As String
|
||||
Select Case sMode:
|
||||
Case T_SOURCE_BOOK: TitlesText = docMeta.BookText
|
||||
Case T_SOURCE_VOLUME: TitlesText = docMeta.VolumeText
|
||||
Case T_SOURCE_DOCUMENT: TitlesText = docMeta.document_
|
||||
Case T_SOURCE_SECTION: TitlesText = sData.sName
|
||||
Case T_SOURCE_CHAPTER: TitlesText = sData.sChapter
|
||||
Case T_SOURCE_CONCEPT:
|
||||
TitlesText = "Öåíòð èííîâàöèé è âûñîêèõ òåõíîëîãèé ""ÊÎÍÖÅÏÒ""" & ", " & CStr(Year(Date))
|
||||
End Select
|
||||
End Function
|
||||
|
||||
Private Function ReplaceColontitle(target As Word.HeaderFooter, cPos As ColontitlePosition, sText$)
|
||||
If cPos.top_ Then
|
||||
Call InsertHeader(target.Range, sText, cPos)
|
||||
If cPos.source_ <> T_SOURCE_DOCUMENT And cPos.source_ <> T_SOURCE_CONCEPT Then _
|
||||
Call BoldHeaderPart(target.Range)
|
||||
Call HeadersWrap(target.Range)
|
||||
Else
|
||||
If cPos.source_ = T_SOURCE_SECTION And InStr(UCase(sText), UCase("Ïðèëîæåíèå")) = 0 Then _
|
||||
sText = Mid(sText, InStr(sText, ".") + 1)
|
||||
Call InsertFooter(target.Range, sText, cPos)
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function BoldHeaderPart(target As Word.Range)
|
||||
target.Bold = False
|
||||
Dim boldPart As Word.Range: Set boldPart = target.Words.First
|
||||
If boldPart.MoveEndUntil(".", wdForward) Then
|
||||
boldPart.End = boldPart.End + 1
|
||||
boldPart.Bold = True
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function InsertHeader(target As Word.Range, sText$, cPos As ColontitlePosition)
|
||||
target.Text = sText
|
||||
target.Style = "Âåðõíèé êîëîíòèòóë"
|
||||
Call target.Words.Last.Delete
|
||||
End Function
|
||||
|
||||
Private Function InsertFooter(target As Word.Range, sText$, cPos As ColontitlePosition)
|
||||
Call CleanFooter(target, cPos)
|
||||
|
||||
If Len(sText) >= 2 Then
|
||||
If Asc(Left(sText, 1)) < 33 Then sText = Mid(sText, 2)
|
||||
If Asc(Right(sText, 1)) < 33 Then sText = Left(sText, Len(sText) - 1)
|
||||
End If
|
||||
|
||||
Call target.InsertBefore(UCase(sText))
|
||||
If cPos.left_ Then
|
||||
Call FormatLeftFooter(target)
|
||||
Else
|
||||
Call FormatRightFooter(target)
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function FormatRightFooter(target As Word.Range)
|
||||
Dim rDest As Word.Range: Set rDest = target.Duplicate
|
||||
Call rDest.MoveEnd(wdWord, -2)
|
||||
|
||||
If Len(rDest.Text) < 30 Then
|
||||
Call rDest.InsertBefore(Chr(11))
|
||||
Else
|
||||
Dim rSecondLine As Word.Range: Set rSecondLine = rDest.Duplicate
|
||||
Call rSecondLine.Collapse(wdCollapseEnd)
|
||||
Do
|
||||
Call rDest.MoveEnd(wdWord, -1)
|
||||
Call rSecondLine.MoveStart(wdWord, -1)
|
||||
Loop Until Len(rDest.Text) + 2 < Len(rSecondLine.Text)
|
||||
|
||||
Call rSecondLine.InsertBefore(Chr(11))
|
||||
Call target.Words.Last.Delete
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function FormatLeftFooter(target As Word.Range)
|
||||
Dim rDest As Word.Range: Set rDest = target.Duplicate
|
||||
Call rDest.MoveEnd(wdWord, IIf(rDest.Fields.Count = 1, -2, -1))
|
||||
|
||||
Dim oldText$
|
||||
If Len(rDest.Text) < 30 Then
|
||||
oldText = rDest.Text
|
||||
Call rDest.Delete
|
||||
|
||||
Call target.InsertBefore(Chr(11))
|
||||
|
||||
Call target.InsertAfter(Chr(9))
|
||||
Call target.InsertAfter(oldText)
|
||||
Call target.InsertBefore(Chr(9))
|
||||
rDest.End = target.End
|
||||
rDest.Start = rDest.End
|
||||
Call rDest.MoveStart(wdWord, -1)
|
||||
Call rDest.Delete
|
||||
Else
|
||||
Dim rSecondLine As Word.Range: Set rSecondLine = rDest.Duplicate
|
||||
Call rSecondLine.Collapse(wdCollapseEnd)
|
||||
Do
|
||||
Call rDest.MoveEnd(wdWord, -1)
|
||||
Call rSecondLine.MoveStart(wdWord, -1)
|
||||
Loop Until Len(rDest.Text) + 2 < Len(rSecondLine.Text) Or rDest.Text = "ÖÅÍÒÐ ÈÍÍÎÂÀÖÈÉ È ÂÛÑÎÊÈÕ ÒÅÕÍÎËÎÃÈÉ "
|
||||
|
||||
Call target.InsertBefore(Chr(9))
|
||||
|
||||
oldText = rSecondLine.Text
|
||||
Call rSecondLine.Delete
|
||||
Call target.InsertAfter(Chr(9))
|
||||
Call target.InsertAfter(oldText)
|
||||
Call rDest.InsertAfter(Chr(11))
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function CleanFooter(target As Word.Range, cPos As ColontitlePosition)
|
||||
target.Style = "Íèæíèé êîëîíòèòóë"
|
||||
|
||||
Dim hasField As Boolean: hasField = target.Fields.Count > 0
|
||||
If hasField Then
|
||||
Call target.Fields(1).Cut
|
||||
Call target.Delete
|
||||
Call target.Paste
|
||||
Else
|
||||
Call target.Delete
|
||||
End If
|
||||
|
||||
If Not cPos.left_ And Not cPos.top_ Then _
|
||||
Call target.InsertBefore(Chr(9))
|
||||
End Function
|
||||
|
||||
Private Function HeadersWrap(target As Word.Range)
|
||||
'Ïîäãîí âåðõíåãî
|
||||
Dim temprang1 As Word.Range, temprang2 As Word.Range
|
||||
If Len(target.Text) < 70 Then
|
||||
Call target.InsertBefore(Chr(11))
|
||||
Else
|
||||
Set temprang2 = target.Duplicate
|
||||
Set temprang1 = target.Duplicate
|
||||
temprang1.End = temprang2.Start
|
||||
Do
|
||||
Call temprang2.MoveStart(wdWord, 1)
|
||||
Call temprang1.MoveEnd(wdWord, 1)
|
||||
Loop Until Len(temprang1.Text) > Len(temprang2.Text)
|
||||
|
||||
Call temprang2.InsertBefore(Chr(11))
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function GetHeader(target As Word.Section, cPos As ColontitlePosition) As Word.HeaderFooter
|
||||
Dim colID As WdHeaderFooterIndex: colID = IIf(cPos.left_, wdHeaderFooterEvenPages, wdHeaderFooterPrimary)
|
||||
If cPos.top_ Then
|
||||
Set GetHeader = target.Headers(colID)
|
||||
Else
|
||||
Set GetHeader = target.Footers(colID)
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function DoLink(sMode As TSource, isNew As Boolean) As Boolean
|
||||
DoLink = (sMode <> T_SOURCE_SECTION And sMode <> T_SOURCE_CHAPTER) Or (sMode = T_SOURCE_CHAPTER And isNew)
|
||||
End Function
|
||||
|
||||
Private Function IsUsualSecName(sName$, target As Word.Range) As Boolean
|
||||
IsUsualSecName = Not (ContainsSubstr(target, "Çàêëþ÷åíèå") + ContainsSubstr(target, "Ââåäåíèå") _
|
||||
+ ContainsSubstr(target, "Ïðèëîæåíèå") + IsToCHeader(sName))
|
||||
End Function
|
||||
|
||||
Function ContainsSubstr(target As Word.Range, subText$) As Boolean
|
||||
ContainsSubstr = False
|
||||
If target.Words.Count < 2 Then _
|
||||
Exit Function
|
||||
ContainsSubstr = InStr(UCase(target.Words.First), UCase(subText)) <> 0
|
||||
End Function
|
||||
|
||||
Private Function IsToCHeader(ByVal secName$) As Boolean
|
||||
secName = UCase(secName)
|
||||
IsToCHeader = InStr(secName, "ÎÃËÀÂËÅÍÈÅ") + InStr(secName, "ÑÎÄÅÐÆÀÍÈÅ")
|
||||
End Function
|
||||
560
src/CD_Layout.bas
Normal file
560
src/CD_Layout.bas
Normal file
|
|
@ -0,0 +1,560 @@
|
|||
Attribute VB_Name = "CD_Layout"
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Public Function InsertOneColomnSection(target As Word.Range)
|
||||
Dim nEnd&: nEnd = target.End
|
||||
Call target.InsertBreak(wdSectionBreakContinuous)
|
||||
Call target.Document.Range(nEnd + 1, nEnd + 1).InsertBreak(wdSectionBreakContinuous)
|
||||
Call target.Sections(1).PageSetup.TextColumns.SetCount(1)
|
||||
End Function
|
||||
|
||||
Public Function InsertHeader(dest As Word.Range, headerName$, nLvl&)
|
||||
Dim headerText$: headerText = Replace(headerName, Chr(11), " ")
|
||||
headerText = Replace(headerText, " ", " ")
|
||||
|
||||
Dim prefixPosition&: prefixPosition = 1
|
||||
Do While Not Mid(headerText, prefixPosition, 1) Like "[à-ÿÀ-ßa-zA-Z¨¸]"
|
||||
prefixPosition = prefixPosition + 1
|
||||
Loop
|
||||
|
||||
Dim headerPrefix$
|
||||
If prefixPosition > 1 Then headerPrefix = Left(headerText, prefixPosition - 2)
|
||||
headerText = Right(headerText, Len(headerText) - prefixPosition + 1)
|
||||
|
||||
Call dest.InsertAfter(headerText & vbNewLine)
|
||||
Dim insRange As Word.Range: Set insRange = dest.Paragraphs.Last.Range
|
||||
insRange.Font.Reset
|
||||
insRange.Style = "Çàãîëîâîê " & Trim(Str(nLvl))
|
||||
insRange.Font.Color = GetSectionHeader(insRange.Start, dest.Document).Font.Color
|
||||
|
||||
If prefixPosition = 1 Then _
|
||||
Exit Function
|
||||
CreateEmptyField(insRange).TextFrame.TextRange.Text = headerPrefix
|
||||
End Function
|
||||
|
||||
Public Function InsertConceptSymbol(dest As Word.Range, symbol$)
|
||||
If symbol = "" Then _
|
||||
Exit Function
|
||||
|
||||
Dim txtShp As Word.Shape
|
||||
Set txtShp = CreateEmptyField(dest)
|
||||
With txtShp.TextFrame.TextRange
|
||||
.Font.Spacing = 0
|
||||
.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
|
||||
.Font.Size = CentimetersToPoints(1.08)
|
||||
.Text = symbol
|
||||
.Font.Color = GetSectionHeader(dest.Start, dest.Document).Font.Color
|
||||
.Font.Name = "conceptpict"
|
||||
End With
|
||||
txtShp.TextFrame.AutoSize = True
|
||||
End Function
|
||||
|
||||
Public Function InsertNewPicture(sFile$, dest As Word.Range)
|
||||
Dim tmpRange As Word.Range: Set tmpRange = dest.Application.Selection.Range
|
||||
|
||||
Dim txtShp As Word.Shape: Set txtShp = CreateEmptyField(dest)
|
||||
txtShp.TextFrame.TextRange.Select
|
||||
Dim picShp As Word.InlineShape: Set picShp = Selection.InlineShapes.AddPicture(sFile)
|
||||
If picShp Is Nothing Then
|
||||
Call UserInteraction.ShowMessage(EM_CANNOT_INSERT_IMAGE)
|
||||
Exit Function
|
||||
End If
|
||||
txtShp.TextFrame.TextRange.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
|
||||
|
||||
picShp.LockAspectRatio = True
|
||||
picShp.Width = CentimetersToPoints(1)
|
||||
txtShp.TextFrame.AutoSize = True
|
||||
|
||||
Dim sPictName$: sPictName = Replace(UserInteraction.PromptInput("Ââåäèòå íàçâàíèå ïèêòîãðàììû, íàïðèìåð:" & vbNewLine & "Pict_99"), " ", "_")
|
||||
Dim sBookmark$: sBookmark = "pict_" & sPictName
|
||||
|
||||
On Error GoTo INVALID_NAME
|
||||
TRY_AGAIN:
|
||||
Call dest.Document.Bookmarks.Add(sBookmark, txtShp.TextFrame.TextRange)
|
||||
Call tmpRange.Select
|
||||
Exit Function
|
||||
|
||||
INVALID_NAME:
|
||||
sBookmark = "pict_" & dest.Document.Bookmarks.Count
|
||||
Call UserInteraction.ShowMessage(IM_FIX_BOOKMARK_NAME, sBookmark)
|
||||
GoTo TRY_AGAIN
|
||||
End Function
|
||||
|
||||
Public Function InsertPictureRef(dest As Word.Range, bookmarkID$)
|
||||
Dim txtShp As Word.Shape: Set txtShp = CreateEmptyField(dest)
|
||||
With txtShp
|
||||
With .TextFrame.TextRange
|
||||
.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
|
||||
Call .Fields.Add(txtShp.TextFrame.TextRange, Text:="REF " & bookmarkID)
|
||||
End With
|
||||
.TextFrame.AutoSize = True
|
||||
End With
|
||||
End Function
|
||||
|
||||
Public Function InsertTextField(dest As Word.Range, insText$)
|
||||
Call dest.Collapse(wdCollapseStart)
|
||||
Call dest.MoveEnd(wdCharacter, 1)
|
||||
CreateEmptyField(dest).TextFrame.TextRange.Text = insText
|
||||
End Function
|
||||
|
||||
Public Function InlineAsPNG(target As Word.InlineShape)
|
||||
Dim isVisio As Boolean: isVisio = False
|
||||
Dim prevW As Double: prevW = 0
|
||||
If Not target.OLEFormat Is Nothing Then
|
||||
If InStr(UCase(target.OLEFormat.ClassType), "VISIO") <> 0 Then
|
||||
isVisio = True
|
||||
prevW = target.Width
|
||||
|
||||
Dim formFactor As Double: formFactor = target.Height / target.Width
|
||||
target.LockAspectRatio = msoFalse
|
||||
target.Width = CentimetersToPoints(20)
|
||||
target.Height = target.Width * formFactor
|
||||
End If
|
||||
End If
|
||||
|
||||
Dim dest As Word.Range: Set dest = target.Range.Duplicate
|
||||
target.Select
|
||||
target.Application.Selection.Cut
|
||||
With dest
|
||||
Call .Collapse(wdCollapseEnd)
|
||||
Call .PasteSpecial(Placement:=wdInLine, DataType:=IIf(isVisio, wdPasteEnhancedMetafile, 14))
|
||||
If isVisio Then
|
||||
Call .MoveStart(wdCharacter, -1)
|
||||
If .InlineShapes(1).Width < prevW Then
|
||||
.InlineShapes(1).LockAspectRatio = msoTrue
|
||||
.InlineShapes(1).Width = prevW
|
||||
Call InlineAsPNG(.InlineShapes(1))
|
||||
Else
|
||||
Call InlineAsPNG(.InlineShapes(1))
|
||||
Call .MoveEnd(wdCharacter, 1)
|
||||
.InlineShapes(1).LockAspectRatio = msoTrue
|
||||
.InlineShapes(1).Width = prevW
|
||||
End If
|
||||
End If
|
||||
End With
|
||||
End Function
|
||||
|
||||
Public Function UpdateListsLayout(target As Word.Document)
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.ListParagraphs.Count)
|
||||
|
||||
Dim aParagraph As Word.Paragraph
|
||||
For Each aParagraph In target.ListParagraphs
|
||||
If aParagraph.Range = target.Paragraphs.Last.Range Then _
|
||||
GoTo NEXT_LIST
|
||||
If aParagraph.Range.Tables.Count > 0 Then _
|
||||
GoTo NEXT_LIST
|
||||
|
||||
Dim rNext As Word.Range: Set rNext = aParagraph.Next.Range
|
||||
If InStr(rNext.Text, Chr(12)) Or InStr(rNext.Text, Chr(14)) Then _
|
||||
GoTo NEXT_LIST
|
||||
If rNext.ListParagraphs.Count <> 0 Then _
|
||||
GoTo NEXT_LIST
|
||||
|
||||
Dim rCurrent As Word.Range: Set rCurrent = aParagraph.Range
|
||||
With rCurrent.ParagraphFormat
|
||||
.SpaceAfter = .SpaceAfter - (Int(.SpaceAfter / .LineSpacing) - 1) * .LineSpacing
|
||||
End With
|
||||
|
||||
NEXT_LIST:
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next aParagraph
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Public Function UpdateTextLayout(target As Word.Document)
|
||||
Call FixGapsStyle(target)
|
||||
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.Range.End)
|
||||
|
||||
Dim aRange As Word.Range: Set aRange = target.Paragraphs.First.Range
|
||||
Do While Not aRange Is Nothing
|
||||
If NeedsAlignment(aRange) Then
|
||||
Dim firstOnPage As Boolean: firstOnPage = IsFirstInColumn(aRange)
|
||||
Dim Headers As HeaderBlock: Headers = FixHeaderBlockSpacing(aRange, firstOnPage)
|
||||
Set aRange = Headers.finishRng
|
||||
Else
|
||||
Set aRange = aRange.Next(wdParagraph, 1)
|
||||
End If
|
||||
If Not aRange Is Nothing Then _
|
||||
Call CSE_ProgressBar.SetB(aRange.End)
|
||||
Loop
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Public Function FixGapsStyle(target As Word.Document)
|
||||
Dim rFind As Word.Range: Set rFind = target.Range.Duplicate
|
||||
With rFind.Find
|
||||
.Text = Chr(12)
|
||||
Do While .Execute
|
||||
If rFind.Previous(wdCharacter, 1) <> Chr(13) Then
|
||||
Call rFind.InsertBefore(Chr(13))
|
||||
If Not rFind.Start = rFind.Paragraphs.First.Range.Start Then _
|
||||
Call rFind.MoveStart(1)
|
||||
End If
|
||||
rFind.ParagraphFormat.Style = "Îáû÷íûé"
|
||||
Loop
|
||||
End With
|
||||
End Function
|
||||
|
||||
Public Function CreateLayoutBlock(target As Word.Range)
|
||||
If target.End = target.Document.Range.End Then _
|
||||
Exit Function
|
||||
|
||||
Dim rStart As Word.Range: Set rStart = target.Duplicate
|
||||
Dim rFinish As Word.Range: Set rFinish = target.Next(wdParagraph, 1).Duplicate
|
||||
Call rStart.Collapse(wdCollapseStart)
|
||||
Call rFinish.Collapse(wdCollapseStart)
|
||||
|
||||
If rStart.Start = rFinish.Start Then _
|
||||
Exit Function
|
||||
If GetColumn(rStart) <> GetColumn(rFinish) Then _
|
||||
Exit Function
|
||||
|
||||
Dim isFirst As Boolean: isFirst = IsFirstInColumn(target)
|
||||
If isFirst Then target.ParagraphFormat.SpaceBefore = 0
|
||||
|
||||
Dim prevAfter As Double: prevAfter = rStart.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter
|
||||
Dim curBefore As Double: curBefore = rStart.ParagraphFormat.SpaceBefore
|
||||
Dim curAfter As Double: curAfter = rFinish.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter
|
||||
Dim nxtBefore As Double: nxtBefore = rFinish.ParagraphFormat.SpaceBefore
|
||||
|
||||
Dim maxAfter As Double: maxAfter = IIf(curAfter > nxtBefore, curAfter, nxtBefore)
|
||||
Dim maxBefore As Double: maxBefore = IIf(curBefore > prevAfter, curBefore, prevAfter)
|
||||
|
||||
Call rFinish.Move(wdCharacter, -1)
|
||||
Call rFinish.InsertAfter(Chr(13))
|
||||
Call rFinish.Move(wdCharacter, 1)
|
||||
rFinish.Style = rFinish.Document.Styles(BASE_STYLE)
|
||||
|
||||
Dim topPosition As Double: topPosition = rStart.Information(wdVerticalPositionRelativeToPage)
|
||||
If IsBorderVisible(rStart, wdBorderTop) Then _
|
||||
topPosition = topPosition - BorderLinewidth(wdBorderTop, rStart) + rStart.Borders.DistanceFromTop
|
||||
|
||||
Dim botPosition As Double: botPosition = rFinish.Information(wdVerticalPositionRelativeToPage)
|
||||
botPosition = botPosition - rFinish.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter
|
||||
|
||||
Dim defSpacing As Double: defSpacing = DefaultSpacing(target.Document)
|
||||
Dim blockHeight As Double: blockHeight = botPosition - topPosition
|
||||
Dim nLines&: nLines = Int((blockHeight + curBefore + curAfter) / defSpacing + 0.5)
|
||||
Dim toAdd As Double: toAdd = (nLines + 1) * defSpacing - (curBefore + curAfter + blockHeight)
|
||||
If Abs(toAdd - defSpacing) < 0.5 Then toAdd = 0
|
||||
|
||||
rFinish.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter = maxAfter + toAdd / IIf(isFirst, 1, 2)
|
||||
rStart.ParagraphFormat.SpaceBefore = maxBefore + toAdd * IIf(isFirst, 0, 0.5)
|
||||
If isFirst Then
|
||||
rFinish.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter = _
|
||||
rFinish.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter + _
|
||||
rStart.ParagraphFormat.SpaceBefore
|
||||
rStart.ParagraphFormat.SpaceBefore = 0
|
||||
End If
|
||||
|
||||
rFinish.Delete
|
||||
|
||||
Do While rStart.ParagraphFormat.SpaceBefore > 1.4 * defSpacing And _
|
||||
(rStart.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter > 1.4 * defSpacing Or _
|
||||
rStart.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter = 0)
|
||||
|
||||
rStart.ParagraphFormat.SpaceBefore = _
|
||||
rStart.ParagraphFormat.SpaceBefore - defSpacing
|
||||
If rStart.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter <> 0 Then _
|
||||
rStart.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter = _
|
||||
rStart.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter - defSpacing
|
||||
Loop
|
||||
|
||||
Do While target.Paragraphs.Last.SpaceAfter > 1.4 * defSpacing And _
|
||||
(target.Paragraphs.Last.Next.SpaceBefore > 1.4 * defSpacing Or _
|
||||
target.Paragraphs.Last.Next.SpaceBefore = 0)
|
||||
|
||||
target.Paragraphs.Last.SpaceAfter = _
|
||||
target.Paragraphs.Last.SpaceAfter - defSpacing
|
||||
If target.Paragraphs.Last.Next.SpaceBefore <> 0 Then _
|
||||
target.Paragraphs.Last.Next.SpaceBefore = _
|
||||
target.Paragraphs.Last.Next.SpaceBefore - defSpacing
|
||||
Loop
|
||||
End Function
|
||||
|
||||
Public Function UpdateObjectFields(target As Word.Document)
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.Shapes.Count)
|
||||
|
||||
Dim aShape As Word.Shape
|
||||
For Each aShape In target.Shapes
|
||||
If IsEndSymbol(aShape) Then _
|
||||
GoTo NEXT_SHAPE
|
||||
Dim ancRange As Word.Range: Set ancRange = aShape.Anchor.Paragraphs(1).Range
|
||||
If Len(ancRange) < 3 Then _
|
||||
GoTo NEXT_SHAPE
|
||||
|
||||
Dim isLeft As Boolean: isLeft = GetColumn(ancRange) = T_COL_LEFT
|
||||
With aShape
|
||||
' Âåðòèêàëüíîå âûðàâíèâàíèå
|
||||
.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
|
||||
.TextFrame.VerticalAnchor = msoAnchorBottom
|
||||
.Top = ancRange.ParagraphFormat.SpaceBefore
|
||||
If .TextFrame.TextRange.Font.Name = "conceptpict" Then
|
||||
.Top = .Top - ancRange.ParagraphFormat.LineSpacing * 1.5 / 2# + .TextFrame.TextRange.ParagraphFormat.LineSpacing / 2#
|
||||
Else
|
||||
.TextFrame.TextRange.ParagraphFormat.LineSpacing = ancRange.ParagraphFormat.LineSpacing
|
||||
End If
|
||||
|
||||
Dim prevNormal As Word.Range: Set prevNormal = ancRange.Previous(wdParagraph)
|
||||
Dim tmpMin As Double: tmpMin = Min(ancRange.ParagraphFormat.SpaceBefore, prevNormal.ParagraphFormat.SpaceAfter)
|
||||
Dim tmpMax As Double: tmpMax = -Min(-ancRange.ParagraphFormat.SpaceBefore, 0)
|
||||
.Top = .Top - IIf(ancRange.Sections.First.Range.Paragraphs.First.Range.Start = ancRange.Start, _
|
||||
tmpMin, IIf(IsFirstInColumn(ancRange) And isLeft, tmpMax, tmpMin))
|
||||
|
||||
' Ãîðèçîíòàëüíîå âûðàâíèâàíèå
|
||||
If .Type = msoTextBox Then
|
||||
.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
|
||||
If isLeft Then
|
||||
.Left = CentimetersToPoints(LEFT_POS_SHIFT) - .Width
|
||||
.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphRight
|
||||
Else
|
||||
.Left = CentimetersToPoints(RIGHT_POS_SHIFT)
|
||||
.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft
|
||||
End If
|
||||
If IsHeader(ancRange) Then _
|
||||
.Top = .Top - .Height / 2# _
|
||||
+ .TextFrame.TextRange.ParagraphFormat.LineSpacing / 2# _
|
||||
- .TextFrame.TextRange.Font.Size * (SPACING_SCALE - 1) / 2#
|
||||
Else
|
||||
.RelativeHorizontalPosition = IIf(isLeft, wdRelativeHorizontalPositionLeftMarginArea, wdRelativeHorizontalPositionRightMarginArea)
|
||||
.Left = wdShapeCenter
|
||||
End If
|
||||
End With
|
||||
|
||||
NEXT_SHAPE:
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next aShape
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Public Function UpdateTableOfContents(target As Word.TableOfContents)
|
||||
Dim initPos As Word.Range: Set initPos = target.Application.Selection.Range
|
||||
|
||||
Call target.Update
|
||||
Dim aLink As Hyperlink
|
||||
For Each aLink In target.Range.Hyperlinks
|
||||
Call aLink.Follow
|
||||
Dim rHeader As Word.Range: Set rHeader = target.Application.Selection.Range
|
||||
If rHeader.ParagraphFormat.OutlineLevel = wdOutlineLevel1 Then _
|
||||
GoTo NXT_LNK
|
||||
|
||||
Call rHeader.MoveStart(wdWord, -1)
|
||||
Dim lineStart As Word.Range: Set lineStart = aLink.Range.Duplicate
|
||||
Call lineStart.Collapse(wdCollapseStart)
|
||||
If rHeader.ShapeRange.Count <> 0 Then
|
||||
Dim rSource As Word.Range: Set rSource = rHeader.ShapeRange(1).TextFrame.TextRange
|
||||
Call rSource.MoveEnd(wdCharacter, -1)
|
||||
lineStart.Text = Chr(9) & rSource.Text & Chr(9)
|
||||
Else
|
||||
lineStart.Text = Chr(9) & Chr(9)
|
||||
End If
|
||||
|
||||
Call lineStart.Select
|
||||
lineStart.ParagraphFormat.Style.BaseStyle = aLink.Range.ParagraphFormat.Style.BaseStyle
|
||||
NXT_LNK:
|
||||
Next aLink
|
||||
|
||||
Call target.Range.Document.ActiveWindow.ScrollIntoView(initPos)
|
||||
End Function
|
||||
|
||||
' =========
|
||||
Private Function Min(i1 As Variant, i2 As Variant) As Variant
|
||||
Min = IIf(i1 < i2, i1, i2)
|
||||
End Function
|
||||
|
||||
Private Function IsEndSymbol(aShape As Word.Shape) As Boolean
|
||||
IsEndSymbol = False
|
||||
If Abs(aShape.Width - 159.875) > 1 Then Exit Function
|
||||
If Abs(aShape.Height - 36) > 1 Then Exit Function
|
||||
IsEndSymbol = True
|
||||
End Function
|
||||
|
||||
Private Function FixHeaderBlockSpacing(target As Word.Range, firstOnPage As Boolean) As HeaderBlock
|
||||
Call FixHeaderSpacing(target, firstOnPage)
|
||||
Dim result As HeaderBlock: result = ScanHeaderBlock(target)
|
||||
Dim kScale As Double: kScale = CalculateHeaderScaling(result, firstOnPage)
|
||||
Call ScaleHeaderSpacing(result, kScale)
|
||||
FixHeaderBlockSpacing = result
|
||||
End Function
|
||||
|
||||
Private Function ScanHeaderBlock(target As Word.Range) As HeaderBlock
|
||||
Dim result As HeaderBlock
|
||||
|
||||
Set result.startRng = target.Duplicate
|
||||
result.yText = target.ParagraphFormat.LineSpacing * target.ComputeStatistics(wdStatisticLines)
|
||||
result.yHeight = result.yText + target.ParagraphFormat.SpaceBefore
|
||||
|
||||
Set result.finishRng = result.startRng.Next(wdParagraph, 1)
|
||||
Do While Not result.finishRng Is Nothing
|
||||
If Not IsHeader(result.finishRng) Then _
|
||||
Exit Do
|
||||
If IsFirstInColumn(result.finishRng) Then _
|
||||
Exit Do
|
||||
|
||||
Call FixHeaderSpacing(result.finishRng, True)
|
||||
|
||||
Dim nextLineSpacing As Double: nextLineSpacing = result.finishRng.ParagraphFormat.LineSpacing
|
||||
result.finishRng.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter = nextLineSpacing
|
||||
|
||||
Dim textH As Double: textH = nextLineSpacing * result.finishRng.ComputeStatistics(wdStatisticLines)
|
||||
result.yText = result.yText + textH
|
||||
result.yHeight = result.yHeight + textH + nextLineSpacing
|
||||
|
||||
Set result.finishRng = result.finishRng.Next(wdParagraph, 1)
|
||||
Loop
|
||||
result.finishRng.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter = result.finishRng.ParagraphFormat.LineSpacing
|
||||
result.yHeight = result.yHeight + result.finishRng.ParagraphFormat.LineSpacing
|
||||
|
||||
ScanHeaderBlock = result
|
||||
End Function
|
||||
|
||||
Private Function CalculateHeaderScaling(block As HeaderBlock, firstOnPage As Boolean) As Double
|
||||
Dim defSpacing As Double: defSpacing = DefaultSpacing(block.startRng.Document)
|
||||
Dim n&: n = CLng(block.yHeight / defSpacing + 0.5) ' TODO: probably should use Int istead of CLng, needs testing
|
||||
If n = 3 And Not firstOnPage Then
|
||||
n = n - 1
|
||||
End If
|
||||
Dim newH As Double: newH = n * defSpacing
|
||||
Dim k As Double: k = (newH - block.yText) / (block.yHeight - block.yText)
|
||||
If k < 0 Then
|
||||
Call UserInteraction.ShowMessage(EM_FIX_LINING_FAIL)
|
||||
Exit Function
|
||||
End If
|
||||
CalculateHeaderScaling = k
|
||||
End Function
|
||||
|
||||
Private Function ScaleHeaderSpacing(block As HeaderBlock, kScale As Double)
|
||||
Dim tmpRng As Word.Range: Set tmpRng = block.startRng.Duplicate
|
||||
Do While Not tmpRng.Start = block.finishRng.Start
|
||||
tmpRng.ParagraphFormat.SpaceBefore = kScale * tmpRng.ParagraphFormat.SpaceBefore
|
||||
tmpRng.ParagraphFormat.SpaceAfter = kScale * tmpRng.ParagraphFormat.SpaceAfter
|
||||
Set tmpRng = tmpRng.Next(wdParagraph, 1)
|
||||
Loop
|
||||
End Function
|
||||
|
||||
Private Function SetHeaderBlockPosition(block As HeaderBlock, firstOnPage As Boolean)
|
||||
Dim defSpacing As Double: defSpacing = DefaultSpacing(block.startRng.Document)
|
||||
Dim prevSpc As Double: prevSpc = block.startRng.Previous(wdParagraph).ParagraphFormat.SpaceAfter
|
||||
Dim curSpc As Double: curSpc = block.startRng.ParagraphFormat.SpaceBefore
|
||||
If prevSpc <> 0 And Not firstOnPage Then _
|
||||
block.startRng.ParagraphFormat.SpaceBefore = prevSpc + ((curSpc * 1000) Mod (defSpacing * 1000)) / 1000
|
||||
|
||||
prevSpc = block.finishRng.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter
|
||||
curSpc = block.finishRng.ParagraphFormat.SpaceBefore
|
||||
If curSpc <> 0 Then _
|
||||
block.finishRng.Previous(wdParagraph, 1).ParagraphFormat.SpaceAfter = curSpc + ((1000 * prevSpc) Mod (defSpacing * 1000)) / 1000
|
||||
End Function
|
||||
|
||||
Private Function FixHeaderSpacing(target As Word.Range, columnStart As Boolean)
|
||||
With target
|
||||
If Not .ParagraphFormat.LineSpacingRule = wdLineSpaceExactly Then
|
||||
.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
|
||||
.ParagraphFormat.LineSpacing = .ParagraphFormat.LineSpacing * SPACING_SCALE
|
||||
End If
|
||||
.ParagraphFormat.Alignment = IIf(GetColumn(target) = T_COL_RIGHT, wdAlignParagraphRight, wdAlignParagraphLeft)
|
||||
.ParagraphFormat.SpaceBefore = IIf(columnStart, 0, .ParagraphFormat.LineSpacing)
|
||||
End With
|
||||
End Function
|
||||
|
||||
Private Function BorderLinewidth(bordertype As WdBorderType, wdrange As Word.Range) As Double
|
||||
BorderLinewidth = 0
|
||||
If wdrange.Borders(bordertype).Visible = False Then Exit Function
|
||||
Select Case wdrange.Borders(bordertype).LineWidth
|
||||
Case wdLineWidth025pt: BorderLinewidth = 0.25
|
||||
Case wdLineWidth050pt: BorderLinewidth = 0.5
|
||||
Case wdLineWidth075pt: BorderLinewidth = 0.75
|
||||
Case wdLineWidth100pt: BorderLinewidth = 1
|
||||
Case wdLineWidth150pt: BorderLinewidth = 1.5
|
||||
Case wdLineWidth225pt: BorderLinewidth = 2.25
|
||||
Case wdLineWidth300pt: BorderLinewidth = 3
|
||||
Case wdLineWidth450pt: BorderLinewidth = 4.5
|
||||
Case wdLineWidth600pt: BorderLinewidth = 6
|
||||
End Select
|
||||
End Function
|
||||
|
||||
Private Function IsBorderVisible(wdrange As Word.Range, wdBorder As WdBorderType) As Boolean
|
||||
IsBorderVisible = wdrange.Borders.Item(wdBorder).Visible
|
||||
End Function
|
||||
|
||||
Private Function RemoveObjectsFrom(dest As Word.Range)
|
||||
Dim i&
|
||||
For i = 1 To dest.ShapeRange.Count
|
||||
Dim aShape As Word.Shape: Set aShape = dest.ShapeRange(i)
|
||||
If aShape.Type = msoTextBox And ((GetColumn(dest) = T_COL_RIGHT And aShape.Left = Int(20 * CentimetersToPoints(RIGHT_POS_SHIFT)) / 20) _
|
||||
Or (GetColumn(dest) = T_COL_LEFT And Abs(aShape.Left) = Int(20 * Abs(CentimetersToPoints(LEFT_POS_SHIFT) - aShape.Width)) / 20)) _
|
||||
Then
|
||||
Call aShape.Delete
|
||||
End If
|
||||
Next i
|
||||
End Function
|
||||
|
||||
Private Function NeedsAlignment(target As Word.Range) As Boolean
|
||||
NeedsAlignment = False
|
||||
|
||||
Dim outLevel&: outLevel = target.ParagraphFormat.OutlineLevel
|
||||
If IsHeader(target, 1) Or outLevel = wdOutlineLevel1 Then _
|
||||
Exit Function
|
||||
If Not IsHeader(target) Then _
|
||||
Exit Function
|
||||
If target.ParagraphFormat.Style = "Çàãîëîâîê îãëàâëåíèÿ" Then _
|
||||
Exit Function
|
||||
|
||||
NeedsAlignment = True
|
||||
End Function
|
||||
|
||||
Private Function CreateEmptyField(dest As Word.Range) As Word.Shape
|
||||
Dim selRange As Word.Range: Set selRange = dest.Application.Selection.Range
|
||||
|
||||
Call RemoveObjectsFrom(dest)
|
||||
|
||||
Dim txtShp As Word.Shape
|
||||
Set txtShp = dest.Document.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, _
|
||||
CentimetersToPoints(FIELD_SIZE_CM), dest.ParagraphFormat.LineSpacing * 1.5, dest)
|
||||
|
||||
If txtShp.Anchor.Start <> dest.Start Then
|
||||
' ÊÎÑÒÛËÜ: Éîõîõî ñáðîñèòü ÿêîðÿ
|
||||
txtShp.Select
|
||||
Selection.Cut
|
||||
dest.Select
|
||||
Selection.Paste
|
||||
Set txtShp = dest.ShapeRange(1)
|
||||
selRange.Select
|
||||
If dest.Characters.First = " " Then _
|
||||
dest.Characters.First.Delete
|
||||
' End of ÊÎÑÒÛËÜ
|
||||
End If
|
||||
|
||||
With txtShp
|
||||
' Ôîðìèòèðîâàíèå òåêñòà
|
||||
With .TextFrame.TextRange
|
||||
.Font = dest.Font
|
||||
.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
|
||||
.ParagraphFormat.LineSpacing = dest.ParagraphFormat.LineSpacing
|
||||
.ParagraphFormat.SpaceBefore = 0
|
||||
.ParagraphFormat.SpaceAfter = 0
|
||||
End With
|
||||
|
||||
' Âûðàâíèâàíèå íà ñòðàíèöå
|
||||
.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
|
||||
.Top = dest.ParagraphFormat.SpaceBefore _
|
||||
- .Height / 2# _
|
||||
+ .TextFrame.TextRange.ParagraphFormat.LineSpacing / 2#
|
||||
|
||||
.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
|
||||
If GetColumn(dest) = T_COL_RIGHT Then
|
||||
.Left = CentimetersToPoints(RIGHT_POS_SHIFT)
|
||||
.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft
|
||||
Else
|
||||
.Left = CentimetersToPoints(LEFT_POS_SHIFT) - .Width
|
||||
.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphRight
|
||||
End If
|
||||
|
||||
' Ðàìêà
|
||||
.Line.Visible = msoFalse
|
||||
End With
|
||||
Set CreateEmptyField = txtShp
|
||||
End Function
|
||||
|
||||
358
src/CD_Paint.bas
Normal file
358
src/CD_Paint.bas
Normal file
|
|
@ -0,0 +1,358 @@
|
|||
Attribute VB_Name = "CD_Paint"
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Public Function RepaintText(target As Word.Document)
|
||||
CSE_ProgressBar.Header = "Ïîêðàñêà âûäåëåíèé..."
|
||||
Call CSE_ProgressBar.InitSecondBar(0, maxVal:=target.Range.End)
|
||||
|
||||
Dim sectionHead As SectionHeader: Set sectionHead.rFind = target.Range.Duplicate
|
||||
sectionHead.nStart = 0
|
||||
sectionHead.nFinish = -1
|
||||
sectionHead.cHeader = wdAuto
|
||||
sectionHead.cText = wdAuto
|
||||
With sectionHead.rFind.Find
|
||||
.Text = ""
|
||||
.Format = True
|
||||
.ParagraphFormat.OutlineLevel = wdOutlineLevel1
|
||||
End With
|
||||
|
||||
Do While IncrementHeader(sectionHead)
|
||||
Call PaintBoldText(sectionHead)
|
||||
Call PaintItalicText(sectionHead)
|
||||
Call CSE_ProgressBar.SetB(sectionHead.nFinish)
|
||||
Loop
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Public Function RepaintTextShapes(target As Word.Document)
|
||||
CSE_ProgressBar.Header = "Ïîêðàñêà âûíîñîê íà ïîëÿõ..."
|
||||
Call CSE_ProgressBar.InitSecondBar(0, maxVal:=target.Shapes.Count)
|
||||
|
||||
Dim aShape As Word.Shape
|
||||
For Each aShape In target.Shapes
|
||||
If aShape.Type = msoTextBox Then
|
||||
Dim ancRange As Word.Range: Set ancRange = aShape.Anchor.Paragraphs(1).Range
|
||||
aShape.TextFrame.TextRange.Font.Color = GetSectionHeader(ancRange.Start, target).Font.Color
|
||||
End If
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next aShape
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Public Function RepaintHLinks(target As Word.Document)
|
||||
CSE_ProgressBar.Header = "Ïîêðàñêà ãèïåðññûëîê..."
|
||||
Call CSE_ProgressBar.InitSecondBar(0, maxVal:=target.Hyperlinks.Count)
|
||||
|
||||
Dim initialPos As Word.Range: Set initialPos = target.ActiveWindow.Selection.Range
|
||||
Dim aLink As Hyperlink
|
||||
For Each aLink In target.Hyperlinks
|
||||
If Not aLink.Address = "" Or aLink.SubAddress Like "_Toc*" Then _
|
||||
GoTo NEXT_LINK
|
||||
|
||||
Call aLink.Follow
|
||||
Dim linkTarget As Word.Range: Set linkTarget = target.ActiveWindow.Selection.Paragraphs(1).Range
|
||||
If linkTarget.ParagraphFormat.OutlineLevel <> wdOutlineLevelBodyText Then _
|
||||
aLink.Range.Font.Color = linkTarget.Font.Color
|
||||
NEXT_LINK:
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next aLink
|
||||
|
||||
Call target.ActiveWindow.ScrollIntoView(initialPos)
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Public Function RepaintToC(target As Word.Document)
|
||||
CSE_ProgressBar.Header = "Ïîêðàñêà îãëàâëåíèÿ..."
|
||||
Dim i&
|
||||
For i = 1 To target.TablesOfContents.Count Step 1
|
||||
Call PaintToC(target.TablesOfContents(i))
|
||||
Next i
|
||||
End Function
|
||||
|
||||
Public Function PaintTable(target As Word.Table, mainColor&, props As TablePaintProps)
|
||||
Dim colorFrame&: colorFrame = ColorAdjustLuma(mainColor, props.cGrid, True)
|
||||
Dim colorHead&: colorHead = ColorAdjustLuma(mainColor, props.cHeading, True)
|
||||
Dim colorSubhead&: colorSubhead = ColorAdjustLuma(mainColor, props.cSubHead, True)
|
||||
Dim colorZebraBright&: colorZebraBright = 16777215 ' Áåëûé
|
||||
Dim colorZebraDark&: colorZebraDark = ColorAdjustLuma(mainColor, props.cZebra, True)
|
||||
|
||||
Dim greyColHead&: greyColHead = ColorGetLuma(colorHead)
|
||||
Dim greyColSub&: greyColSub = ColorGetLuma(colorSubhead)
|
||||
Dim greyColZebra&: greyColZebra = ColorGetLuma(colorZebraDark)
|
||||
|
||||
With target
|
||||
' Îáùèå ïàðàìåòðû
|
||||
.AllowPageBreaks = True
|
||||
.AllowAutoFit = False
|
||||
|
||||
.PreferredWidthType = wdPreferredWidthPercent
|
||||
.PreferredWidth = 100
|
||||
|
||||
.Rows.HeightRule = wdRowHeightAuto
|
||||
.Rows.Height = CentimetersToPoints(0)
|
||||
|
||||
.TopPadding = CentimetersToPoints(props.textSpacing)
|
||||
.BottomPadding = CentimetersToPoints(props.textSpacing)
|
||||
.LeftPadding = CentimetersToPoints(props.textSpacing)
|
||||
.RightPadding = CentimetersToPoints(props.textSpacing)
|
||||
.Spacing = 0
|
||||
|
||||
' Ãðàíèöû
|
||||
With .Borders(wdBorderLeft)
|
||||
.LineStyle = wdLineStyleSingle
|
||||
.LineWidth = TABLE_FRAME_THICKNESS
|
||||
.Color = colorFrame
|
||||
End With
|
||||
With .Borders(wdBorderTop)
|
||||
.LineStyle = wdLineStyleSingle
|
||||
.LineWidth = TABLE_FRAME_THICKNESS
|
||||
.Color = colorFrame
|
||||
End With
|
||||
With .Borders(wdBorderRight)
|
||||
.LineStyle = wdLineStyleSingle
|
||||
.LineWidth = TABLE_FRAME_THICKNESS
|
||||
.Color = colorFrame
|
||||
End With
|
||||
With .Borders(wdBorderBottom)
|
||||
.LineStyle = wdLineStyleSingle
|
||||
.LineWidth = TABLE_FRAME_THICKNESS
|
||||
.Color = colorFrame
|
||||
End With
|
||||
|
||||
With .Borders(wdBorderHorizontal)
|
||||
.LineStyle = wdLineStyleSingle
|
||||
.LineWidth = TABLE_CELL_THICKNESS
|
||||
.Color = colorFrame
|
||||
End With
|
||||
With .Borders(wdBorderVertical)
|
||||
.LineStyle = wdLineStyleSingle
|
||||
.LineWidth = TABLE_CELL_THICKNESS
|
||||
.Color = colorFrame
|
||||
End With
|
||||
|
||||
|
||||
With .Rows(1)
|
||||
With .Borders(wdBorderBottom)
|
||||
.LineStyle = wdLineStyleSingle
|
||||
.LineWidth = TABLE_FRAME_THICKNESS
|
||||
.Color = colorFrame
|
||||
End With
|
||||
|
||||
.Range.Font.ColorIndex = IIf(greyColHead < 127, wdWhite, wdBlack)
|
||||
.Shading.BackgroundPatternColor = colorHead
|
||||
End With
|
||||
End With
|
||||
|
||||
' Îðãàíèçóåì çåáðó
|
||||
Dim whiteFlag As Boolean: whiteFlag = True
|
||||
Dim nRow As Integer: nRow = 2
|
||||
For nRow = 2 To target.Rows.Count
|
||||
If target.Cell(nRow, 1).Range.Font.Bold = True Then
|
||||
target.Rows(nRow).Range.Font.ColorIndex = IIf(greyColSub < 127, wdWhite, wdBlack)
|
||||
target.Rows(nRow).Shading.BackgroundPatternColor = colorSubhead
|
||||
whiteFlag = True
|
||||
Else
|
||||
If whiteFlag Then
|
||||
target.Rows(nRow).Shading.BackgroundPatternColor = colorZebraBright
|
||||
Else
|
||||
target.Rows(nRow).Range.Font.ColorIndex = IIf(greyColZebra < 127, wdWhite, wdBlack)
|
||||
target.Rows(nRow).Shading.BackgroundPatternColor = colorZebraDark
|
||||
End If
|
||||
whiteFlag = Not whiteFlag
|
||||
End If
|
||||
Next nRow
|
||||
End Function
|
||||
|
||||
Public Function PaintTableProto(target As Word.Table, proto As Word.Table)
|
||||
' Êðàñèì òàáëèöó â ñîîòâåòñòâèè ñ âûáðàííûì ïðîòîòèïîì
|
||||
Dim colorHead&: colorHead = proto.Cell(2, 1).Shading.BackgroundPatternColor
|
||||
Dim colorBright&: colorBright = proto.Cell(3, 1).Shading.BackgroundPatternColor
|
||||
Dim colorDark&: colorDark = proto.Cell(4, 1).Shading.BackgroundPatternColor
|
||||
|
||||
' Îáùèå ïàðàìåòðû
|
||||
With target
|
||||
With .Borders(wdBorderLeft)
|
||||
.LineStyle = proto.Borders(wdBorderLeft).LineStyle
|
||||
.LineWidth = proto.Borders(wdBorderLeft).LineWidth
|
||||
.Color = proto.Borders(wdBorderLeft).Color
|
||||
End With
|
||||
With .Borders(wdBorderTop)
|
||||
.LineStyle = proto.Borders(wdBorderTop).LineStyle
|
||||
.LineWidth = proto.Borders(wdBorderTop).LineWidth
|
||||
.Color = proto.Borders(wdBorderTop).Color
|
||||
End With
|
||||
With .Borders(wdBorderRight)
|
||||
.LineStyle = proto.Borders(wdBorderRight).LineStyle
|
||||
.LineWidth = proto.Borders(wdBorderRight).LineWidth
|
||||
.Color = proto.Borders(wdBorderRight).Color
|
||||
End With
|
||||
With .Borders(wdBorderBottom)
|
||||
.LineStyle = proto.Borders(wdBorderBottom).LineStyle
|
||||
.LineWidth = proto.Borders(wdBorderBottom).LineWidth
|
||||
.Color = proto.Borders(wdBorderBottom).Color
|
||||
End With
|
||||
|
||||
With .Borders(wdBorderHorizontal)
|
||||
.LineStyle = proto.Borders(wdBorderVertical).LineStyle
|
||||
.LineWidth = proto.Borders(wdBorderVertical).LineWidth
|
||||
.Color = proto.Borders(wdBorderVertical).Color
|
||||
End With
|
||||
With .Borders(wdBorderVertical)
|
||||
.LineStyle = proto.Borders(wdBorderVertical).LineStyle
|
||||
.LineWidth = proto.Borders(wdBorderVertical).LineWidth
|
||||
.Color = proto.Borders(wdBorderVertical).Color
|
||||
End With
|
||||
|
||||
.Borders(wdBorderDiagonalDown).LineStyle = proto.Borders(wdBorderDiagonalDown).LineStyle
|
||||
.Borders(wdBorderDiagonalUp).LineStyle = proto.Borders(wdBorderDiagonalUp).LineStyle
|
||||
.Borders.Shadow = proto.Borders.Shadow
|
||||
End With
|
||||
|
||||
With target
|
||||
.AllowPageBreaks = proto.AllowPageBreaks
|
||||
.AllowAutoFit = proto.AllowAutoFit
|
||||
|
||||
.PreferredWidthType = wdPreferredWidthPoints
|
||||
.PreferredWidth = CentimetersToPoints(15.92)
|
||||
.Rows.HeightRule = wdRowHeightAuto
|
||||
.Rows.Height = CentimetersToPoints(0)
|
||||
|
||||
.TopPadding = proto.TopPadding
|
||||
.BottomPadding = proto.BottomPadding
|
||||
.LeftPadding = proto.LeftPadding
|
||||
.RightPadding = proto.RightPadding
|
||||
.Spacing = proto.Spacing
|
||||
|
||||
With .Rows(1)
|
||||
.Borders(wdBorderBottom).LineStyle = proto.Rows(1).Borders(wdBorderBottom).LineStyle
|
||||
.Borders(wdBorderBottom).LineWidth = proto.Rows(1).Borders(wdBorderBottom).LineWidth
|
||||
.Borders(wdBorderBottom).Color = proto.Rows(1).Borders(wdBorderBottom).Color
|
||||
.Shading.BackgroundPatternColor = proto.Cell(1, 1).Shading.BackgroundPatternColor
|
||||
End With
|
||||
End With
|
||||
|
||||
' Îðãàíèçóåì çåáðó
|
||||
Dim whiteFlag As Boolean: whiteFlag = True
|
||||
Dim nRow&: nRow = 2
|
||||
For nRow = 2 To target.Rows.Count
|
||||
If target.Cell(nRow, 1).Range.Font.Bold = True Then
|
||||
target.Rows(nRow).Shading.BackgroundPatternColor = colorHead
|
||||
whiteFlag = True
|
||||
Else
|
||||
If whiteFlag Then
|
||||
target.Rows(nRow).Shading.BackgroundPatternColor = colorBright
|
||||
Else
|
||||
target.Rows(nRow).Shading.BackgroundPatternColor = colorDark
|
||||
End If
|
||||
whiteFlag = Not whiteFlag
|
||||
End If
|
||||
Next nRow
|
||||
End Function
|
||||
|
||||
' ==========
|
||||
Private Function PaintToC(target As Word.TableOfContents)
|
||||
Dim tocElement As Word.Range: Set tocElement = target.Range.Paragraphs.First.Range
|
||||
Dim rHeader As Word.Range: Set rHeader = target.Range.Document.Range
|
||||
With rHeader.Find
|
||||
.Text = ""
|
||||
.Format = True
|
||||
.ParagraphFormat.OutlineLevel = wdOutlineLevel1
|
||||
End With
|
||||
|
||||
On Error GoTo REPORT_ERROR
|
||||
Dim theEnd&: theEnd = target.Range.End
|
||||
Do While rHeader.Find.Execute
|
||||
If Len(rHeader.Text) < 3 Then _
|
||||
GoTo NEXT_SECTION_HEADER
|
||||
|
||||
Do While Not tocElement.Font.AllCaps = True
|
||||
Set tocElement = tocElement.Next(wdParagraph, 1)
|
||||
If tocElement.End > theEnd Then _
|
||||
GoTo REPORT_ERROR
|
||||
Loop
|
||||
tocElement.Font.Color = rHeader.Font.Color
|
||||
Set tocElement = tocElement.Next(wdParagraph, 1)
|
||||
|
||||
NEXT_SECTION_HEADER:
|
||||
Call rHeader.Collapse(wdCollapseEnd)
|
||||
Loop
|
||||
Exit Function
|
||||
REPORT_ERROR:
|
||||
Call UserInteraction.ShowMessage(EM_INVALID_CONTENTS_TABLE)
|
||||
End Function
|
||||
|
||||
Private Function IncrementHeader(ByRef target As SectionHeader) As Boolean
|
||||
IncrementHeader = False
|
||||
If target.nFinish >= target.rFind.Document.Sections.Last.Range.Start - 1 Then _
|
||||
Exit Function
|
||||
If Not target.rFind.Find.Execute Then _
|
||||
Exit Function
|
||||
|
||||
Dim theHeader As Word.Range: Set theHeader = target.rFind.Duplicate
|
||||
Dim lastSection As Boolean: lastSection = Not target.rFind.Find.Execute
|
||||
Do While Len(target.rFind.Text) < 3 And Not lastSection
|
||||
Call target.rFind.Collapse(wdCollapseEnd)
|
||||
lastSection = Not target.rFind.Find.Execute
|
||||
Loop
|
||||
|
||||
Call target.rFind.Collapse(wdCollapseStart)
|
||||
target.nStart = theHeader.End + 1
|
||||
target.nFinish = IIf(lastSection, target.rFind.Document.Sections.Last.Range.Start - 1, target.rFind.Start - 1)
|
||||
target.cText = ColorGetRGB(theHeader.Font.Color, target.rFind.Document)
|
||||
target.cHeader = ColorAdjustLuma(target.cText, 1000 * TEXT_BOLD_LUMSCALE, True)
|
||||
|
||||
IncrementHeader = True
|
||||
End Function
|
||||
|
||||
Private Function PaintBoldText(target As SectionHeader)
|
||||
Dim rFind As Word.Range: Set rFind = target.rFind.Document.Range(target.nStart, target.nStart)
|
||||
With rFind
|
||||
.Find.Text = ""
|
||||
.Find.Format = True
|
||||
.Find.Font.Bold = True
|
||||
|
||||
Do While .Find.Execute And .End < target.nFinish
|
||||
If .OMaths.Count > 0 Or .Tables.Count > 0 Then _
|
||||
GoTo NEXT_RANGE
|
||||
If .Style Like "*Ôîðìóëà*" Then _
|
||||
GoTo NEXT_RANGE
|
||||
If Not .CharacterStyle Is Nothing Then
|
||||
If .CharacterStyle Like "*Ôîðìóëà*" Then _
|
||||
GoTo NEXT_RANGE
|
||||
End If
|
||||
|
||||
.Font.Color = IIf(.ParagraphFormat.OutlineLevel = wdOutlineLevelBodyText, target.cText, target.cHeader)
|
||||
|
||||
NEXT_RANGE:
|
||||
Call .Collapse(wdCollapseEnd)
|
||||
Loop
|
||||
End With
|
||||
End Function
|
||||
|
||||
Private Function PaintItalicText(target As SectionHeader)
|
||||
Dim rFind As Word.Range: Set rFind = target.rFind.Document.Range(target.nStart, target.nStart)
|
||||
With rFind
|
||||
.Find.Text = ""
|
||||
.Find.Format = True
|
||||
.Find.Font.Italic = True
|
||||
|
||||
Do While .Find.Execute And .End < target.nFinish
|
||||
If .OMaths.Count > 0 Or .Tables.Count > 0 Then _
|
||||
GoTo NEXT_RANGE
|
||||
If .Style Like "*Ôîðìóëà*" Then _
|
||||
GoTo NEXT_RANGE
|
||||
If Not .CharacterStyle Is Nothing Then
|
||||
If .CharacterStyle Like "*Ôîðìóëà*" Then _
|
||||
GoTo NEXT_RANGE
|
||||
End If
|
||||
|
||||
.Font.Color = IIf(.ParagraphFormat.OutlineLevel = wdOutlineLevelBodyText, target.cText, target.cHeader)
|
||||
|
||||
NEXT_RANGE:
|
||||
Call .Collapse(wdCollapseEnd)
|
||||
Loop
|
||||
End With
|
||||
End Function
|
||||
115
src/CD_RedesignFonts.bas
Normal file
115
src/CD_RedesignFonts.bas
Normal file
|
|
@ -0,0 +1,115 @@
|
|||
Attribute VB_Name = "CD_RedesignFonts"
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Public Function ExecuteRedesign(target As Word.Document, props As ItemFontScale)
|
||||
target.Styles(BASE_STYLE).ParagraphFormat.LineSpacing = props.lineSpacing_
|
||||
target.Styles(BASE_STYLE).Font.Size = props.textSize_
|
||||
|
||||
Call CSE_ProgressBar.Init("Èçìåíåíèå øðèôòîâ", maxVal:=3)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
Call RedesignHeader(target, props)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
|
||||
Call RedesignRegularStyles(target, props)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
|
||||
Call RedesignText(target, props)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
|
||||
Unload CSE_ProgressBar
|
||||
End Function
|
||||
|
||||
' ===========
|
||||
Private Function RedesignHeader(target As Word.Document, props As ItemFontScale)
|
||||
CSE_ProgressBar.Header = "Èçìåíåíèå çàãîëîâêîâ"
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.Styles.Count)
|
||||
Dim aStyle As Word.Style
|
||||
For Each aStyle In target.Styles
|
||||
If Not IsStyleMajor(aStyle) Then _
|
||||
GoTo NEXT_STYLE
|
||||
|
||||
aStyle.Font.Size = aStyle.Font.Size * props.fontMultiplier_
|
||||
|
||||
If Not RequiresSpacingFix(aStyle) Then _
|
||||
GoTo NEXT_STYLE
|
||||
|
||||
Dim oldScale As Double: oldScale = GetStyleScale(aStyle, props.fontFactor_)
|
||||
With aStyle.ParagraphFormat
|
||||
.LineSpacing = .LineSpacing * props.fontMultiplier_ * props.spacing_ / oldScale
|
||||
.SpaceAfter = .SpaceAfter * props.fontMultiplier_ * props.spacing_ / oldScale
|
||||
.SpaceBefore = .SpaceBefore * props.fontMultiplier_ * props.spacing_ / oldScale
|
||||
End With
|
||||
NEXT_STYLE:
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next aStyle
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Private Function RedesignRegularStyles(target As Word.Document, props As ItemFontScale)
|
||||
CSE_ProgressBar.Header = "Èçìåíåíèå áàçîâîãî òåêñòà"
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.Styles.Count)
|
||||
|
||||
Dim aStyle As Word.Style
|
||||
For Each aStyle In target.Styles
|
||||
If Not RequiresRegularFix(aStyle) Then _
|
||||
GoTo NEXT_STYLE
|
||||
With aStyle.ParagraphFormat
|
||||
.SpaceAfter = .SpaceAfter * props.fontMultiplier_ * props.spacing_
|
||||
.SpaceBefore = .SpaceBefore * props.fontMultiplier_ * props.spacing_
|
||||
End With
|
||||
NEXT_STYLE:
|
||||
Call CSE_ProgressBar.IncrementB
|
||||
Next aStyle
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Private Function RedesignText(target As Word.Document, props As ItemFontScale)
|
||||
CSE_ProgressBar.Header = "Èçìåíåíèå îòñòóïîâ"
|
||||
Call CSE_ProgressBar.InitSecondBar(0, target.ListParagraphs.Count)
|
||||
|
||||
Dim para As Word.Paragraph
|
||||
For Each para In target.ListParagraphs
|
||||
If Not IsHeader(para.Range) And para.SpaceAfter <> 0 Then _
|
||||
para.SpaceAfter = props.lineSpacing_
|
||||
CSE_ProgressBar.IncrementB
|
||||
Next para
|
||||
|
||||
Call CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
Private Function IsStyleMajor(aStyle As Word.Style) As Boolean
|
||||
IsStyleMajor = _
|
||||
aStyle.NameLocal Like "[Îî]ãëàâëåíèå*" Or _
|
||||
aStyle.NameLocal Like "[Çç]àãîëîâîê [Îî]ãëàâëåíèÿ" Or _
|
||||
aStyle.NameLocal Like "[Íí]àçâàíèå îáúåêòà" Or _
|
||||
aStyle.NameLocal Like "[Çç]àãîëîâîê #" Or _
|
||||
aStyle.NameLocal Like "[Òò]àáëèöà*"
|
||||
End Function
|
||||
|
||||
Private Function RequiresSpacingFix(aStyle As Word.Style)
|
||||
RequiresSpacingFix = _
|
||||
aStyle.NameLocal Like "[Çç]àãîëîâîê #" Or _
|
||||
aStyle.NameLocal Like "[Òò]àáëèöà*"
|
||||
End Function
|
||||
|
||||
Private Function RequiresRegularFix(aStyle As Word.Style)
|
||||
RequiresRegularFix = _
|
||||
UCase(aStyle.NameLocal) Like "!ÀÁÇÀÖ ÂÀÆÍÎ" Or _
|
||||
UCase(aStyle.NameLocal) Like "!ÀÁÇÀÖ Ñ ÐÀÌÊÎÉ" Or _
|
||||
UCase(aStyle.NameLocal) Like "ÔÎÐÌÓËÀ"
|
||||
End Function
|
||||
|
||||
Private Function GetStyleScale(aStyle As Word.Style, fontFactor As Double) As Double
|
||||
Dim spacingType As WdLineSpacing: spacingType = aStyle.ParagraphFormat.LineSpacingRule
|
||||
Select Case (spacingType)
|
||||
Case wdLineSpace1pt5: GetStyleScale = 1.5
|
||||
Case wdLineSpaceDouble: GetStyleScale = 2
|
||||
Case wdLineSpaceMultiple: GetStyleScale = aStyle.ParagraphFormat.LineSpacing
|
||||
Case wdLineSpaceExactly: GetStyleScale = aStyle.ParagraphFormat.LineSpacing / aStyle.Font.Size / fontFactor
|
||||
Case Else: GetStyleScale = 1
|
||||
End Select
|
||||
End Function
|
||||
307
src/CD_SplitTable.bas
Normal file
307
src/CD_SplitTable.bas
Normal file
|
|
@ -0,0 +1,307 @@
|
|||
Attribute VB_Name = "CD_SplitTable"
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Public Function PrepareTableForSplit(target As Word.Table)
|
||||
Call SetupPageBeforeSlice(target)
|
||||
Call InsertSplittingMarker(target)
|
||||
End Function
|
||||
|
||||
Public Function RemoveSplitMarkerFrom(target As Word.Table)
|
||||
On Error Resume Next
|
||||
target.Cell(1, 1).Range.ShapeRange.Delete
|
||||
End Function
|
||||
|
||||
Public Function SliceTable(target As Word.Table) As Collection
|
||||
Dim startingRows As Collection: Set startingRows = PrepareStartingRows(target)
|
||||
|
||||
Dim slices As New Collection
|
||||
Dim nIndex&
|
||||
For nIndex = startingRows.Count To 2 Step -1
|
||||
Call target.Rows(1).Select
|
||||
target.Application.Selection.Copy
|
||||
Dim rPaste As Word.Range: Set rPaste = target.Range
|
||||
Call rPaste.Collapse(wdCollapseEnd)
|
||||
Call rPaste.InsertBreak(wdSectionBreakNextPage)
|
||||
Call rPaste.Paste
|
||||
|
||||
Dim rowStart&: rowStart = startingRows(nIndex)
|
||||
Dim rowFinish&: rowFinish = target.Rows.Count + 1
|
||||
target.Rows(rowStart).Select
|
||||
Dim k&
|
||||
For k = 1 To rowFinish - rowStart - 1
|
||||
Call Selection.MoveDown(wdLine, Extend:=wdExtend)
|
||||
Next k
|
||||
|
||||
target.Application.Selection.Copy
|
||||
Call rPaste.Collapse(wdCollapseEnd)
|
||||
Call rPaste.Paste
|
||||
target.Application.Selection.Rows.Delete
|
||||
|
||||
Call slices.Add(rPaste.Sections.First.Range.Tables(1))
|
||||
Next nIndex
|
||||
Call slices.Add(target)
|
||||
|
||||
Set SliceTable = slices
|
||||
End Function
|
||||
|
||||
Public Function SplitSlices(slices As Collection)
|
||||
Call CSE_ProgressBar.InitSecondBar(0, slices.Count)
|
||||
Dim tablePart As Variant
|
||||
For Each tablePart In slices
|
||||
Call tablePart.Select
|
||||
Call SplitTable(tablePart.Application.Selection.Tables(1))
|
||||
CSE_ProgressBar.IncrementB
|
||||
Next tablePart
|
||||
CSE_ProgressBar.HideSecondBar
|
||||
End Function
|
||||
|
||||
' ============
|
||||
Private Function SplitTable(target As Word.Table)
|
||||
If target.Rows(1).Cells.Count = 0 Then
|
||||
Call UserInteraction.ShowMessage(EM_TABLE_MERGED_CELLS)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim horiz As Double, vert As Double
|
||||
Dim tmpRange As Word.Range
|
||||
Set tmpRange = target.Application.Selection.Document.Range(target.Range.End - 1, target.Range.End - 1)
|
||||
horiz = tmpRange.Information(wdHorizontalPositionRelativeToPage)
|
||||
vert = tmpRange.Information(wdVerticalPositionRelativeToPage)
|
||||
|
||||
Dim runner As Variant
|
||||
If target.Rows(1).Cells.Count < 2 Then
|
||||
Call UserInteraction.ShowMessage(EM_INVALID_TABLE_COLUMNS)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
For Each runner In target.Rows(1).Cells
|
||||
Set tmpRange = runner.Range
|
||||
Call tmpRange.Collapse(wdCollapseStart)
|
||||
If PointsToCentimeters(tmpRange.Information(wdHorizontalPositionRelativeToPage)) > TABLE_CRITICAL_WIDTH Then
|
||||
runner.Select
|
||||
GoTo SELECT_MOVE
|
||||
End If
|
||||
Next runner
|
||||
|
||||
SELECT_MOVE:
|
||||
Set tmpRange = target.Application.Selection.Range
|
||||
Call tmpRange.Collapse(wdCollapseEnd)
|
||||
|
||||
Do While tmpRange.Information(wdHorizontalPositionRelativeToPage) <> horiz
|
||||
Call target.Application.Selection.MoveRight(wdCharacter, Extend:=wdExtend)
|
||||
Set tmpRange = target.Application.Selection.Range
|
||||
Call tmpRange.Collapse(wdCollapseEnd)
|
||||
Loop
|
||||
|
||||
Do While tmpRange.Information(wdVerticalPositionRelativeToPage) <> vert Or tmpRange.End <> target.Range.End - 1
|
||||
Call Selection.MoveDown(wdLine, Extend:=wdExtend)
|
||||
Set tmpRange = target.Application.Selection.Range
|
||||
Call tmpRange.Collapse(wdCollapseEnd)
|
||||
Loop
|
||||
|
||||
Do While tmpRange.Information(wdHorizontalPositionRelativeToPage) <> horiz
|
||||
Call target.Application.Selection.MoveRight(wdCharacter, Extend:=wdExtend)
|
||||
Set tmpRange = target.Application.Selection.Range
|
||||
Call tmpRange.Collapse(wdCollapseEnd)
|
||||
Loop
|
||||
|
||||
Set tmpRange = target.Range
|
||||
Call tmpRange.Collapse(wdCollapseEnd)
|
||||
|
||||
Call tmpRange.Collapse(wdCollapseEnd)
|
||||
Call tmpRange.InsertBreak(wdSectionBreakNextPage)
|
||||
tmpRange.Collapse (wdCollapseEnd)
|
||||
|
||||
Dim nmeRng As Word.Range
|
||||
Set nmeRng = target.Range.Document.Range(target.Range.Sections(1).Range.Start, target.Range.Start)
|
||||
|
||||
Dim beforeTable As Double: beforeTable = TabNameHeight(target)
|
||||
If beforeTable > 0 Then
|
||||
Call nmeRng.Copy
|
||||
tmpRange.Paste
|
||||
tmpRange.Collapse (wdCollapseEnd)
|
||||
nmeRng.Font.ColorIndex = wdWhite
|
||||
End If
|
||||
|
||||
target.Application.Selection.Copy
|
||||
tmpRange.Paste
|
||||
target.Application.Selection.Columns.Delete
|
||||
|
||||
Dim curSec As Word.Section, nextSec As Word.Section
|
||||
Set curSec = target.Range.Sections.First
|
||||
Set nextSec = tmpRange.Sections.First
|
||||
|
||||
Call DoPortraitPageSetup(curSec.PageSetup)
|
||||
Call DoPortraitPageSetup(nextSec.PageSetup)
|
||||
|
||||
target.PreferredWidthType = wdPreferredWidthPoints
|
||||
target.PreferredWidth = CentimetersToPoints(21 - 2 * FIELD_SIZE_CM)
|
||||
|
||||
Dim victim As Word.Table
|
||||
Set victim = nextSec.Range.Tables(1)
|
||||
victim.PreferredWidthType = wdPreferredWidthPoints
|
||||
victim.PreferredWidth = CentimetersToPoints(21 - 2 * FIELD_SIZE_CM)
|
||||
|
||||
Dim tSecBot As Double, vSecBot As Double
|
||||
tSecBot = target.Range.Sections(1).PageSetup.BottomMargin
|
||||
vSecBot = victim.Range.Sections(1).PageSetup.BottomMargin
|
||||
|
||||
target.Range.Sections(1).PageSetup.BottomMargin = tSecBot / 4
|
||||
victim.Range.Sections(1).PageSetup.BottomMargin = vSecBot / 4
|
||||
Dim i As Integer, tH As Double, vH As Double
|
||||
For i = 1 To target.Rows.Count Step 1
|
||||
tH = Badheight(target.Rows(i))
|
||||
vH = Badheight(victim.Rows(i))
|
||||
target.Rows(i).HeightRule = wdRowHeightExactly
|
||||
victim.Rows(i).HeightRule = wdRowHeightExactly
|
||||
target.Rows(i).Height = IIf(tH > vH, tH, vH) - 3
|
||||
victim.Rows(i).Height = IIf(tH > vH, tH, vH) - 3
|
||||
Next i
|
||||
|
||||
target.Range.Sections(1).PageSetup.BottomMargin = tSecBot
|
||||
victim.Range.Sections(1).PageSetup.BottomMargin = vSecBot
|
||||
|
||||
If target.Cell(1, 1).Range.Information(wdActiveEndPageNumber) <> _
|
||||
target.Rows.Last.Cells(1).Range.Information(wdActiveEndPageNumber) Then
|
||||
target.Rows.Last.HeightRule = wdRowHeightAuto
|
||||
End If
|
||||
|
||||
If victim.Cell(1, 1).Range.Information(wdActiveEndPageNumber) <> _
|
||||
victim.Rows.Last.Cells(1).Range.Information(wdActiveEndPageNumber) Then
|
||||
victim.Rows.Last.HeightRule = wdRowHeightAuto
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Function RowHeight(wdrow As Word.Row) As Double
|
||||
Dim tmpCell As Variant
|
||||
Dim jumper As Word.Range, strt As Double, ent As Double, tmpMax As Double
|
||||
Dim bln As Boolean: bln = Application.ScreenUpdating
|
||||
Application.ScreenUpdating = False
|
||||
For Each tmpCell In wdrow.Cells
|
||||
Set jumper = tmpCell.Range
|
||||
Set jumper = jumper.Document.Range(jumper.End - 1, jumper.End - 1)
|
||||
jumper.InsertAfter (Chr(11))
|
||||
|
||||
Set jumper = tmpCell.Range
|
||||
Set jumper = jumper.Document.Range(jumper.Start, jumper.Start)
|
||||
strt = jumper.Information(wdVerticalPositionRelativeToPage)
|
||||
Set jumper = tmpCell.Range
|
||||
Set jumper = jumper.Document.Range(jumper.End - 1, jumper.End - 1)
|
||||
ent = jumper.Information(wdVerticalPositionRelativeToPage)
|
||||
|
||||
Set jumper = tmpCell.Range
|
||||
Set jumper = jumper.Document.Range(jumper.End - 2, jumper.End - 1)
|
||||
jumper.Delete
|
||||
tmpMax = IIf(tmpMax > ent - strt + jumper.ParagraphFormat.SpaceAfter, tmpMax, ent - strt + jumper.ParagraphFormat.SpaceAfter)
|
||||
Next tmpCell
|
||||
Application.ScreenUpdating = bln
|
||||
RowHeight = tmpMax
|
||||
End Function
|
||||
|
||||
Private Function Badheight(wdrow As Word.Row) As Double
|
||||
Dim strt As Double, ent As Double
|
||||
strt = wdrow.Cells(1).Range.Information(wdVerticalPositionRelativeToPage)
|
||||
ent = InsertFictiveAfter(wdrow)
|
||||
Badheight = IIf(ent > strt, ent - strt, CentimetersToPoints(TABLE_CRITICAL_HEIGHT) - strt)
|
||||
End Function
|
||||
|
||||
Private Function InsertFictiveAfter(wdrow As Word.Row) As Double
|
||||
wdrow.Select
|
||||
With wdrow.Application.Selection
|
||||
.InsertRowsBelow (1)
|
||||
.Font.Size = 1
|
||||
.Font.Scaling = 1
|
||||
.Rows.HeightRule = wdRowHeightExactly
|
||||
.Rows.Height = 0
|
||||
InsertFictiveAfter = .Range.Information(wdVerticalPositionRelativeToPage)
|
||||
Selection.Rows.Delete
|
||||
End With
|
||||
End Function
|
||||
|
||||
Private Function TabNameHeight(wdTable As Word.Table) As Double
|
||||
If wdTable.Range.Start = wdTable.Range.Sections.First.Range.Start Then
|
||||
TabNameHeight = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim nameRange As Word.Range
|
||||
With wdTable.Range
|
||||
Set nameRange = .Document.Range(.Sections.First.Range.Start, .Start)
|
||||
End With
|
||||
|
||||
Dim tmpRange As Word.Range
|
||||
Dim cumHeight As Double
|
||||
With nameRange
|
||||
|
||||
Set tmpRange = .Duplicate
|
||||
Call tmpRange.Collapse(wdCollapseStart)
|
||||
cumHeight = tmpRange.Information(wdVerticalPositionRelativeToPage) - tmpRange.ParagraphFormat.SpaceBefore
|
||||
|
||||
Set tmpRange = .Duplicate
|
||||
Call tmpRange.Collapse(wdCollapseEnd)
|
||||
cumHeight = tmpRange.Information(wdVerticalPositionRelativeToPage) _
|
||||
- tmpRange.ParagraphFormat.SpaceBefore - cumHeight - 3
|
||||
End With
|
||||
|
||||
TabNameHeight = IIf(cumHeight < 0, 0, cumHeight)
|
||||
End Function
|
||||
|
||||
' ============
|
||||
Private Function SetupPageBeforeSlice(target As Word.Table)
|
||||
Call DoPortraitPageSetup(target.Range.Sections.First.PageSetup)
|
||||
With target.Range.Sections.First.PageSetup
|
||||
.PageWidth = 2 * .PageWidth - 2 * .LeftMargin
|
||||
target.PreferredWidthType = wdPreferredWidthPoints
|
||||
target.PreferredWidth = .PageWidth - .LeftMargin - .RightMargin
|
||||
End With
|
||||
End Function
|
||||
|
||||
Private Function DoPortraitPageSetup(ByRef pSetup As PageSetup)
|
||||
With pSetup
|
||||
.Orientation = wdOrientPortrait
|
||||
.PageHeight = CentimetersToPoints(29.7)
|
||||
.PageWidth = CentimetersToPoints(21)
|
||||
.TopMargin = CentimetersToPoints(FIELD_SIZE_CM)
|
||||
.BottomMargin = .TopMargin
|
||||
.LeftMargin = CentimetersToPoints(FIELD_SIZE_CM)
|
||||
.RightMargin = .LeftMargin
|
||||
End With
|
||||
End Function
|
||||
|
||||
Private Function PrepareStartingRows(target As Word.Table) As Collection
|
||||
Dim startingRows As New Collection
|
||||
Dim previousY As Double: previousY = -1
|
||||
Dim nRow&
|
||||
For nRow = 1 To target.Rows.Count
|
||||
Dim currentY As Double: currentY = target.Rows(nRow).Cells(1).Range.Information(wdVerticalPositionRelativeToPage)
|
||||
If currentY < previousY Or Badheight(target.Rows(nRow - 1)) > CentimetersToPoints(TABLE_CRITICAL_HEIGHT) Then
|
||||
Call startingRows.Add(nRow)
|
||||
End If
|
||||
previousY = currentY
|
||||
Next nRow
|
||||
|
||||
Set PrepareStartingRows = startingRows
|
||||
End Function
|
||||
|
||||
Private Function InsertSplittingMarker(target As Word.Table)
|
||||
Dim pSetup As PageSetup: Set pSetup = target.Range.Sections.First.PageSetup
|
||||
Dim center As Double: center = (pSetup.PageWidth - 2 * pSetup.TopMargin) / 2
|
||||
Dim firstCell As Word.Cell: Set firstCell = target.Cell(1, 1)
|
||||
|
||||
Call firstCell.Select
|
||||
Dim sMarker As Word.Shape
|
||||
Set sMarker = target.Parent.Shapes.AddShape(msoShapeDownArrow, center - 15, 0, 30, 60)
|
||||
sMarker.Fill.ForeColor.RGB = RGB(112, 48, 160)
|
||||
sMarker.Select
|
||||
target.Application.Selection.Cut
|
||||
Call firstCell.Range.Characters.First.Paste
|
||||
|
||||
Dim markerAncore As Word.ShapeRange: Set markerAncore = firstCell.Range.ShapeRange
|
||||
With markerAncore
|
||||
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
|
||||
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
|
||||
.Left = center - 15
|
||||
.Top = -pSetup.TopMargin
|
||||
End With
|
||||
End Function
|
||||
122
src/CD_WordModule.bas
Normal file
122
src/CD_WordModule.bas
Normal file
|
|
@ -0,0 +1,122 @@
|
|||
Attribute VB_Name = "CD_WordModule"
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Public Function GetSectionHeader(aPos&, theDoc As Word.Document) As Word.Range
|
||||
' Âîçâðàùàåò ðåíäæ ñ çàãîëîâêîì äëÿ ðàçäåëà, â êîòîðîì íàõîäèòñÿ äàííàÿ ïîçèöèÿ
|
||||
Dim rFind As Word.Range: Set rFind = theDoc.Range(aPos, aPos)
|
||||
With rFind.Find
|
||||
.Text = ""
|
||||
.Format = True
|
||||
.Forward = False
|
||||
.ParagraphFormat.OutlineLevel = wdOutlineLevel1
|
||||
|
||||
If .Execute = False Then _
|
||||
Exit Function
|
||||
|
||||
Do While Len(rFind.Text) < 3
|
||||
rFind.Collapse Direction:=wdCollapseStart
|
||||
If .Execute = False Then _
|
||||
Exit Function
|
||||
Loop
|
||||
End With
|
||||
If rFind.Start <= aPos Then _
|
||||
Set GetSectionHeader = rFind
|
||||
End Function
|
||||
|
||||
Public Function DefaultSpacing(theDoc As Word.Document) As Double
|
||||
DefaultSpacing = theDoc.Styles(BASE_STYLE).ParagraphFormat.LineSpacing
|
||||
End Function
|
||||
|
||||
Public Function GetColumn(aRange As Word.Range) As TColumn
|
||||
' Ôóíêöèÿ ïðîâåðÿåò íàõîäèòñÿ ëè çàäàííûé äèàïàçîí â ëåâîé êîëîíêå èëè â ïðàâîé
|
||||
Call CleanBeginning(aRange)
|
||||
Dim wordX As Double: wordX = aRange.Information(wdHorizontalPositionRelativeToPage)
|
||||
If wordX > SECOND_COL_POS Then
|
||||
GetColumn = T_COL_RIGHT
|
||||
Else
|
||||
GetColumn = T_COL_LEFT
|
||||
End If
|
||||
End Function
|
||||
|
||||
Public Function IsHeader(aRange As Word.Range, Optional uplim As Integer = 9) As Boolean
|
||||
' Ïðîâåðÿåì çàãîëîâîê èëè íåò
|
||||
IsHeader = True
|
||||
|
||||
If aRange.Tables.Count <> 0 Or aRange.Hyperlinks.Count <> 0 Then _
|
||||
GoTo RETURN_FALSE
|
||||
|
||||
If Not aRange.Style Is Nothing Then
|
||||
If aRange.Style Like "[Çç]àãîëîâîê #*" Then
|
||||
If CInt(Mid(aRange.Style, 11, 1)) <= uplim Then
|
||||
Exit Function
|
||||
ElseIf uplim < 9 Then
|
||||
GoTo RETURN_FALSE
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
If aRange.ParagraphFormat.OutlineLevel <= uplim Then
|
||||
Exit Function
|
||||
ElseIf uplim < 9 Then
|
||||
GoTo RETURN_FALSE
|
||||
End If
|
||||
|
||||
If Not aRange.Style Is Nothing Then _
|
||||
If aRange.Style Like "*[Çç]àãîëîâîê*" Then _
|
||||
Exit Function
|
||||
|
||||
RETURN_FALSE:
|
||||
IsHeader = False
|
||||
End Function
|
||||
|
||||
Public Function IsFirstInColumn(aRange As Word.Range) As Boolean
|
||||
' Ïðîâåðÿåì ïåðâûé ëè çàãîëîâîê â êîëîíêå
|
||||
IsFirstInColumn = True
|
||||
If aRange.Characters.First Like "[" & Chr(12) & Chr(14) & "]" Then
|
||||
Call CleanBeginning(aRange)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim prevRange As Word.Range: Set prevRange = aRange.Previous(wdParagraph, 1)
|
||||
If prevRange Is Nothing Then _
|
||||
Exit Function
|
||||
|
||||
If prevRange.PageSetup.TextColumns.Count < 2 Then _
|
||||
Exit Function
|
||||
If Not GetColumn(aRange) = GetColumn(prevRange.Words.Last) Then _
|
||||
Exit Function
|
||||
If prevRange.Information(wdActiveEndPageNumber) <> aRange.Information(wdActiveEndPageNumber) Then _
|
||||
Exit Function
|
||||
|
||||
IsFirstInColumn = False
|
||||
End Function
|
||||
|
||||
Public Function FontLineSpacing(wdFont As Word.Font) As Double
|
||||
Dim wdrange As Word.Range: Set wdrange = ActiveDocument.Range.Duplicate
|
||||
Call wdrange.Collapse(wdCollapseEnd)
|
||||
wdrange.InsertBreak (0)
|
||||
Call wdrange.InsertAfter(Chr(13) & Chr(13) & Chr(13) & Chr(13))
|
||||
|
||||
wdrange.Font = wdFont
|
||||
With wdrange.ParagraphFormat
|
||||
.SpaceBefore = 0
|
||||
.SpaceAfter = 0
|
||||
.LineSpacingRule = wdLineSpaceSingle
|
||||
End With
|
||||
|
||||
Dim upper As Double, lower As Double
|
||||
lower = wdrange.Paragraphs(3).Range.Information(wdVerticalPositionRelativeToPage)
|
||||
upper = wdrange.Paragraphs(1).Range.Information(wdVerticalPositionRelativeToPage)
|
||||
FontLineSpacing = (lower - upper) / 2 / wdFont.Size
|
||||
FontLineSpacing = Int(FontLineSpacing / 0.05 + 0.5) * 0.05 * wdFont.Size
|
||||
FontLineSpacing = Int(FontLineSpacing / 0.05 + 0.5) * 0.05
|
||||
|
||||
Call wdrange.MoveStart(wdCharacter, -2)
|
||||
wdrange.Delete
|
||||
End Function
|
||||
|
||||
' ==========
|
||||
Private Function CleanBeginning(target As Word.Range)
|
||||
Call target.MoveStartWhile(Chr(12) & Chr(14))
|
||||
End Function
|
||||
136
src/Declarations.bas
Normal file
136
src/Declarations.bas
Normal file
|
|
@ -0,0 +1,136 @@
|
|||
Attribute VB_Name = "Declarations"
|
||||
Option Explicit
|
||||
|
||||
' TODO: refactor this whole mess
|
||||
Public Const FOOTER_SYMBOL_BREAK = 30
|
||||
|
||||
Public Const CSET_SLETTERS = "àáâãäå¸æçèéêëìíîïðñòóôõö÷øùúûüýþÿabcdefghijklmnopqrstuvwxyz"
|
||||
Public Const CSET_BLETTERS = "ÀÁÂÃÄŨÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||||
|
||||
Public Const BASE_STYLE = "!Àáçàö òåêñòà"
|
||||
|
||||
Public Const FIELD_SIZE_CM As Double = 2.54
|
||||
|
||||
' Íàñêîëüêî òåìíåå áóäåò âûäåëåíèå â òåêñòå îòíîñèòåëüíî çàãîëîâêà
|
||||
Public Const TEXT_BOLD_LUMSCALE = -0.2
|
||||
|
||||
' Íàñòðîéêè îòòåíêîâ äëÿ òàáëèö
|
||||
Public Const TABLE_FRAME_LUMSCALE = -0.35
|
||||
Public Const TABLE_HEAD_LUMSCALE = 0.2
|
||||
Public Const TABLE_SUBHEAD_LUMSCALE = 0.3
|
||||
Public Const TABLE_ZEBRA_LUMSCALE = 0.8
|
||||
Public Const TABLE_FRAME_THICKNESS = 18
|
||||
Public Const TABLE_CELL_THICKNESS = 12
|
||||
|
||||
Public Const SECOND_COL_POS = 300
|
||||
|
||||
Public Const TABLE_CRITICAL_WIDTH As Double = 16
|
||||
Public Const TABLE_CRITICAL_HEIGHT As Double = 22
|
||||
|
||||
Public Const RIGHT_POS_SHIFT = 8#
|
||||
Public Const LEFT_POS_SHIFT = -0.25
|
||||
|
||||
' Â çàâèñèìîñòè îò øðèôòà çàãîëîâê àíóæíî ñòàâèòü ñïåöèàëüíóþ êîíñòàíòó
|
||||
Public Const SPACING_SCALE = 1.15 ' Times New Roman
|
||||
|
||||
' Èäåíòèôèêàòîð êîëîíêè (ëåâî-ïðàâî)
|
||||
Public Enum TColumn
|
||||
T_COL_LEFT
|
||||
T_COL_RIGHT
|
||||
End Enum
|
||||
|
||||
' Ðåæèì íàïîëíåíèÿ êîëîíòèòóëà
|
||||
Public Enum TSource
|
||||
T_SOURCE_BOOK
|
||||
T_SOURCE_VOLUME
|
||||
T_SOURCE_SECTION
|
||||
T_SOURCE_DOCUMENT
|
||||
T_SOURCE_CHAPTER
|
||||
T_SOURCE_CONCEPT
|
||||
End Enum
|
||||
|
||||
' Òèï êîëîíòèòóëà
|
||||
Public Type ColontitlePosition
|
||||
top_ As Boolean
|
||||
left_ As Boolean
|
||||
source_ As TSource
|
||||
End Type
|
||||
|
||||
' Íàñòðîéêà ðàñêðàñêè òàáëèöû
|
||||
Public Type TablePaintProps
|
||||
cGrid As Long
|
||||
cHeading As Long
|
||||
cSubHead As Long
|
||||
cZebra As Long
|
||||
sectionColor As Long
|
||||
textSpacing As Double
|
||||
End Type
|
||||
|
||||
' Ïàðàìåòðû áëîêà çàãîëîâêîâ
|
||||
Public Type HeaderBlock
|
||||
yText As Double
|
||||
yHeight As Double
|
||||
startRng As Word.Range
|
||||
finishRng As Word.Range
|
||||
End Type
|
||||
|
||||
' Íàñòðîéêà àâòîìàêèòèðîâàíèÿ
|
||||
Public Type AutoDesignOptions
|
||||
reapplyLists As Boolean
|
||||
fixObjects As Boolean
|
||||
titlePage As Boolean
|
||||
doLayout As Boolean
|
||||
generateColontitles As Boolean
|
||||
|
||||
Count As Integer
|
||||
End Type
|
||||
|
||||
' Ïàðàìåòðû òèòóëüíîé ñòðàíèöû
|
||||
Public Type TitlePageData
|
||||
sVolume As String
|
||||
nVolumeID As Long
|
||||
sBook As String
|
||||
nBookID As Long
|
||||
|
||||
rContract As Word.Range
|
||||
rCustomer As Word.Range
|
||||
rTheme As Word.Range
|
||||
End Type
|
||||
|
||||
' Ïîëîæåíèÿ ðàçäåëîâ
|
||||
Public Type SectionHeader
|
||||
rFind As Word.Range
|
||||
nStart As Long
|
||||
nFinish As Long
|
||||
cText As Long
|
||||
cHeader As Long
|
||||
End Type
|
||||
|
||||
Public Type SectionData
|
||||
sName As String
|
||||
sChapter As String
|
||||
bNewChapter As Boolean
|
||||
End Type
|
||||
|
||||
Public Function DesignTheme(ThemeColorIndex As WdThemeColorIndex) As Long
|
||||
Select Case ThemeColorIndex:
|
||||
Case wdThemeColorMainDark1: DesignTheme = Format("&HD000FFFF")
|
||||
Case wdThemeColorMainLight1: DesignTheme = Format("&HD100FFFF")
|
||||
Case wdThemeColorMainDark2: DesignTheme = Format("&HD200FFFF")
|
||||
Case wdThemeColorMainLight2: DesignTheme = Format("&HD300FFFF")
|
||||
Case wdThemeColorAccent1: DesignTheme = Format("&HD400FFFF")
|
||||
Case wdThemeColorAccent2: DesignTheme = Format("&HD500FFFF")
|
||||
Case wdThemeColorAccent3: DesignTheme = Format("&HD600FFFF")
|
||||
Case wdThemeColorAccent4: DesignTheme = Format("&HD700FFFF")
|
||||
Case wdThemeColorAccent5: DesignTheme = Format("&HD800FFFF")
|
||||
Case wdThemeColorAccent6: DesignTheme = Format("&HD900FFFF")
|
||||
Case wdThemeColorHyperlink: DesignTheme = Format("&HDA00FFFF")
|
||||
Case wdThemeColorHyperlinkFollowed: DesignTheme = Format("&HDB00FFFF")
|
||||
Case wdThemeColorBackground1: DesignTheme = Format("&HDC00FFFF")
|
||||
Case wdThemeColorText1: DesignTheme = Format("&HDD00FFFF")
|
||||
Case wdThemeColorBackground2: DesignTheme = Format("&HDE00FFFF")
|
||||
Case wdThemeColorText2: DesignTheme = Format("&HDF00FFFF")
|
||||
Case Else:
|
||||
End Select
|
||||
End Function
|
||||
|
||||
21
src/DevHelper.bas
Normal file
21
src/DevHelper.bas
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
Attribute VB_Name = "DevHelper"
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Public Function Dev_PrepareSkeleton()
|
||||
' Do nothing
|
||||
End Function
|
||||
|
||||
Public Function Dev_ManualRunTest()
|
||||
Dim sSuite$: sSuite = "s_UndoWrapper"
|
||||
Dim sTest$: sTest = "t_BasicUndo"
|
||||
Dim sMsg$: sMsg = Dev_RunTestDebug(sSuite, sTest)
|
||||
Debug.Print sMsg
|
||||
Call MsgBox(sMsg)
|
||||
End Function
|
||||
|
||||
Public Function Dev_GetTestSuite(sName$) As Object
|
||||
Select Case sName
|
||||
' Case "s_TextEdit": Set Dev_GetTestSuite = New s_TextEdit
|
||||
End Select
|
||||
End Function
|
||||
35
src/IconPicker.cls
Normal file
35
src/IconPicker.cls
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "IconPicker"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private m_Form As CDD_AddPict
|
||||
Private WithEvents m_Picto As MSForms.Label
|
||||
Attribute m_Picto.VB_VarHelpID = -1
|
||||
Private WithEvents m_Name As MSForms.Label
|
||||
Attribute m_Name.VB_VarHelpID = -1
|
||||
|
||||
Public Sub AssignControls(crtForm As CDD_AddPict, topLbl As MSForms.Label, nmeLbl As MSForms.Label)
|
||||
Set m_Form = crtForm
|
||||
Set m_Picto = topLbl
|
||||
Set m_Name = nmeLbl
|
||||
End Sub
|
||||
|
||||
Private Sub m_Name_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
|
||||
execPicto
|
||||
End Sub
|
||||
|
||||
Private Sub m_Picto_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
|
||||
execPicto
|
||||
End Sub
|
||||
|
||||
Private Sub execPicto()
|
||||
m_Form.Choice = m_Picto
|
||||
m_Form.Hide
|
||||
End Sub
|
||||
68
src/InfoDocument.cls
Normal file
68
src/InfoDocument.cls
Normal file
|
|
@ -0,0 +1,68 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "InfoDocument"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public volume_ As String
|
||||
Public volumeNo_ As Long
|
||||
Public book_ As String
|
||||
Public bookNo_ As Long
|
||||
Public document_ As String
|
||||
|
||||
Public Function Init(theDoc As Word.Document)
|
||||
document_ = theDoc.Name
|
||||
document_ = Left(document_, IIf(InStr(document_, ".") - 1 < 0, 0, InStr(document_, ".") - 1))
|
||||
|
||||
Dim rFind As Word.Range
|
||||
Set rFind = theDoc.Sections(1).Range
|
||||
With rFind.Find
|
||||
.Text = "Êíèãà "
|
||||
.Format = True
|
||||
.MatchCase = False
|
||||
' .Style = "ß_Òèòóë Íàçâàíèå êíèãè"
|
||||
End With
|
||||
If rFind.Find.Execute Then
|
||||
Set rFind = rFind.Next(wdWord, 1)
|
||||
bookNo_ = CLng(rFind.Text)
|
||||
|
||||
Call rFind.MoveEndUntil(CSET_SLETTERS & CSET_BLETTERS, wdForward)
|
||||
rFind.Start = rFind.End
|
||||
Call rFind.MoveEndUntil(Chr(13), wdForward)
|
||||
book_ = rFind
|
||||
End If
|
||||
|
||||
Set rFind = theDoc.Sections(1).Range
|
||||
With rFind.Find
|
||||
.Text = "Òîì "
|
||||
.Format = True
|
||||
.MatchCase = False
|
||||
' .Style = "ß_Òèòóë Íàçâàíèå Òîìà"
|
||||
End With
|
||||
If rFind.Find.Execute Then
|
||||
Set rFind = rFind.Next(wdWord, 1)
|
||||
volumeNo_ = CLng(rFind.Text)
|
||||
|
||||
Call rFind.MoveEndUntil(CSET_SLETTERS & CSET_BLETTERS, wdForward)
|
||||
rFind.Start = rFind.End
|
||||
Call rFind.MoveEndUntil(Chr(13))
|
||||
volume_ = rFind
|
||||
End If
|
||||
End Function
|
||||
|
||||
Public Function IsValidNames() As Boolean
|
||||
IsValidNames = volume_ <> "" And book_ <> ""
|
||||
End Function
|
||||
|
||||
Public Property Get BookText() As String
|
||||
BookText = "Êíèãà " & Trim(Str(bookNo_)) & ". " & book_
|
||||
End Property
|
||||
|
||||
Public Property Get VolumeText() As String
|
||||
VolumeText = "Òîì " & Trim(Str(volumeNo_)) & ". " & volume_
|
||||
End Property
|
||||
22
src/ItemChapter.cls
Normal file
22
src/ItemChapter.cls
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "ItemChapter"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public start_ As Long
|
||||
Public finish_ As Long
|
||||
Public text_ As String
|
||||
|
||||
Public Function Clone() As ItemChapter
|
||||
Dim aClone As New ItemChapter
|
||||
aClone.start_ = start_
|
||||
aClone.finish_ = finish_
|
||||
aClone.text_ = text_
|
||||
Set Clone = aClone
|
||||
End Function
|
||||
23
src/ItemColontitles.cls
Normal file
23
src/ItemColontitles.cls
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "ItemColontitles"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public start_ As Long
|
||||
Public finish_ As Long
|
||||
|
||||
Public doTopLeft As Boolean
|
||||
Public doTopRight As Boolean
|
||||
Public doBottomLeft As Boolean
|
||||
Public doBottomRight As Boolean
|
||||
|
||||
Public mTopLeft As TSource
|
||||
Public mTopRight As TSource
|
||||
Public mBottomLeft As TSource
|
||||
Public mBottomRight As TSource
|
||||
24
src/ItemFontScale.cls
Normal file
24
src/ItemFontScale.cls
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
VERSION 1.0 CLASS
|
||||
BEGIN
|
||||
MultiUse = -1 'True
|
||||
END
|
||||
Attribute VB_Name = "ItemFontScale"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = False
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public lineSpacing_ As Double
|
||||
Public fontMultiplier_ As Double
|
||||
Public textSize_ As Double
|
||||
Public spacing_ As Double
|
||||
Public fontFactor_ As Double
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
lineSpacing_ = -1
|
||||
fontMultiplier_ = 1
|
||||
textSize_ = 11
|
||||
spacing_ = 1
|
||||
fontFactor_ = 1.15
|
||||
End Sub
|
||||
334
src/Main.bas
Normal file
334
src/Main.bas
Normal file
|
|
@ -0,0 +1,334 @@
|
|||
Attribute VB_Name = "Main"
|
||||
Option Explicit
|
||||
|
||||
Public Sub CDA_AutoDesign()
|
||||
Call CDD_AutoDesign.Show
|
||||
If Not CDD_AutoDesign.isCancelled_ Then _
|
||||
Call RunAutoDesign(CDD_AutoDesign.Preferences)
|
||||
|
||||
Call Unload(CDD_AutoDesign)
|
||||
Call UserInteraction.ShowMessage(IM_AUTODESIGN_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_FixLines()
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
|
||||
Call CSE_ProgressBar.Init("Áàëàíñèðîâàíèå", "Âûðàâíèâàíèå çàãîëîâêîâ...", maxVal:=3)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
' Ôèêñèì çàãîëîâêè òàê, ÷òîáû âûïîëíÿëîñü âûðàâíèâàíèå
|
||||
Call UpdateListsLayout(theDoc)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
|
||||
Call UpdateTextLayout(theDoc)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
|
||||
' Ôèêñèì êàðòèíêè è âûíîñêè
|
||||
Call UpdateObjectFields(theDoc)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
|
||||
Call Unload(CSE_ProgressBar)
|
||||
Call UserInteraction.ShowMessage(IM_FIX_LINES_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_Repaint()
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
|
||||
Call CDD_Paint.Init
|
||||
Call CDD_Paint.Show
|
||||
If CDD_Paint.isCancelled_ Then _
|
||||
Exit Sub
|
||||
|
||||
Dim wordUI As New API_WordWrapper: Call wordUI.SetDocument(theDoc)
|
||||
Call wordUI.PauseUI
|
||||
|
||||
Call CSE_ProgressBar.Init("Ïîêðàñêà", maxVal:=CDD_Paint.Count)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
If CDD_Paint.DoText Then
|
||||
Call RepaintText(theDoc)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End If
|
||||
|
||||
If CDD_Paint.DoFields Then
|
||||
Call RepaintTextShapes(theDoc)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End If
|
||||
|
||||
If CDD_Paint.DoToC Then
|
||||
Call RepaintToC(theDoc)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End If
|
||||
|
||||
If CDD_Paint.DoLinks Then
|
||||
Call RepaintHLinks(theDoc)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
End If
|
||||
|
||||
Call Unload(CSE_ProgressBar)
|
||||
Call wordUI.ResumeUI
|
||||
Call UserInteraction.ShowMessage(IM_REPAINT_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_FooterHeader()
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
Dim docMeta As New InfoDocument: Call docMeta.Init(theDoc)
|
||||
|
||||
Call CDD_HeaderFooter.Init(theDoc, docMeta.IsValidNames)
|
||||
Call CDD_HeaderFooter.Show
|
||||
If CDD_HeaderFooter.isCancelled_ Then _
|
||||
Exit Sub
|
||||
|
||||
Dim props As ItemColontitles: Set props = CDD_HeaderFooter.Data
|
||||
Call Unload(CDD_HeaderFooter)
|
||||
|
||||
Call CSE_ProgressBar.Init("Îôîðìëåíèå êîëîíòèòóëîâ", sHeader:="Çàïîëíåíèå...", maxVal:=props.finish_ - props.start_ + 1)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
Call CreateColontitles(theDoc, docMeta, props, "IncrementA")
|
||||
|
||||
Call Unload(CSE_ProgressBar)
|
||||
Call UserInteraction.ShowMessage(IM_FOOTER_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_InsertBreak()
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
Dim theRange As Word.Range: Set theRange = theDoc.ActiveWindow.Selection.Range
|
||||
If Selection.Range.Start = Selection.Range.End Then
|
||||
Set theRange = Selection.Paragraphs(1).Range
|
||||
End If
|
||||
|
||||
Call InsertOneColomnSection(theRange)
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_InsertHeader()
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
|
||||
Dim sHeader$: sHeader = UserInteraction.PromptInput("Ââåäèòå òåêñò çàãîëîâêà")
|
||||
If sHeader = vbNullString Then _
|
||||
Exit Sub
|
||||
Dim nLevel&: nLevel = Int(UserInteraction.PromptInput("Ââåäèòå óðîâåíü çàãîëîâêà"))
|
||||
If nLevel < 2 And nLevel > 5 Then _
|
||||
Exit Sub
|
||||
|
||||
Dim theRange As Word.Range: Set theRange = theDoc.ActiveWindow.Selection.Range
|
||||
If theRange.Paragraphs.Count < 2 Then
|
||||
Set theRange = theRange.Paragraphs(1).Range
|
||||
End If
|
||||
|
||||
Call InsertHeader(theRange, sHeader, nLevel)
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_UpdateToC()
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
|
||||
Dim wordUI As New API_WordWrapper: Call wordUI.SetDocument(theDoc)
|
||||
Call wordUI.PauseUI
|
||||
|
||||
Dim toc As Word.TableOfContents
|
||||
For Each toc In theDoc.TablesOfContents
|
||||
Call UpdateTableOfContents(toc)
|
||||
Call RepaintToC(toc)
|
||||
Next toc
|
||||
|
||||
Call wordUI.ResumeUI
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_TSAlign()
|
||||
If ActiveDocument.ActiveWindow.Selection.Tables.Count <> 1 Then
|
||||
Call UserInteraction.ShowMessage(EM_TABLE_NOT_SELECTED)
|
||||
Exit Sub
|
||||
End If
|
||||
Call PrepareTableForSplit(ActiveDocument.ActiveWindow.Selection.Tables(1))
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_TSSlice()
|
||||
If ActiveDocument.ActiveWindow.Selection.Tables.Count <> 1 Then
|
||||
Call UserInteraction.ShowMessage(EM_TABLE_NOT_SELECTED)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim target As Word.Table: Set target = ActiveDocument.ActiveWindow.Selection.Tables(1)
|
||||
If target.Rows(1).Cells.Count = 0 Then
|
||||
Call UserInteraction.ShowMessage(EM_TABLE_MERGED_CELLS)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Call RemoveSplitMarkerFrom(target)
|
||||
ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
|
||||
target.Rows.AllowBreakAcrossPages = False
|
||||
|
||||
Call CSE_ProgressBar.Init("Íàðåçêà òàáëèöû", maxVal:=2)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
Dim wordUI As New API_WordWrapper: Call wordUI.SetDocument(ActiveDocument)
|
||||
Call wordUI.PauseUI
|
||||
|
||||
CSE_ProgressBar.Description = "Ïîäãîòîâêà ôðàãìåíòîâ..."
|
||||
Dim slices As New Collection: Set slices = SliceTable(target)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
|
||||
CSE_ProgressBar.Description = "Ðàçäåëåíèå òàáëèöû..."
|
||||
Call SplitSlices(slices)
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
|
||||
With ActiveWindow.ActivePane.View.Zoom
|
||||
.PageColumns = 2
|
||||
.PageRows = 1
|
||||
End With
|
||||
|
||||
Call wordUI.ResumeUI
|
||||
Call Unload(CSE_ProgressBar)
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_TSPaint()
|
||||
' Ïîêðàñêà òàáëèöû ÷åðåç ïðîòîòèï
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
Dim target As Word.Range: Set target = theDoc.Application.Selection.Range
|
||||
If target.Tables.Count < 1 Then
|
||||
Call UserInteraction.ShowMessage(EM_TABLE_NOT_SELECTED)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Call CDD_TablePrototype.Init(theDoc.Tables.Count)
|
||||
Call CDD_TablePrototype.Show
|
||||
If CDD_TablePrototype.isCancelled_ Then _
|
||||
Exit Sub
|
||||
|
||||
Dim nPrototype&: nPrototype = CDD_TablePrototype.GetPickedID
|
||||
Dim applyToAll As Boolean: applyToAll = CDD_TablePrototype.applyToAll
|
||||
Call Unload(CDD_TablePrototype)
|
||||
|
||||
If nPrototype = 0 Then _
|
||||
Exit Sub
|
||||
|
||||
Call RunPaintTableProto(target, IIf(applyToAll, target.Tables.Count, 1), theDoc.Tables(nPrototype))
|
||||
Call UserInteraction.ShowMessage(IM_REPAINT_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_PaintTable()
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
Dim rSelection As Word.Range: Set rSelection = theDoc.Application.Selection.Range
|
||||
Dim tableCount&: tableCount = rSelection.Tables.Count
|
||||
If rSelection.Tables.Count < 1 Then
|
||||
Call UserInteraction.ShowMessage(EM_TABLE_NOT_SELECTED)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim headRange As Word.Range: Set headRange = GetSectionHeader(rSelection.Start, theDoc)
|
||||
If headRange Is Nothing Then
|
||||
Call UserInteraction.ShowMessage(EM_TABLE_OUTSIDE_SECTION)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Call CDD_TableColors.Init(ColorGetRGB(headRange.Font.Color, theDoc))
|
||||
Call CDD_TableColors.Show
|
||||
If CDD_TableColors.isCancelled_ Then _
|
||||
Exit Sub
|
||||
Dim props As TablePaintProps: props = CDD_TableColors.TableProperties
|
||||
Call Unload(CDD_TableColors)
|
||||
|
||||
Call RunPaintTable(rSelection, tableCount, props)
|
||||
|
||||
Call UserInteraction.ShowMessage(IM_REPAINT_OK)
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_InlineFields()
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
Dim aField As Word.Field
|
||||
For Each aField In theDoc.Fields
|
||||
If aField.Type = wdFieldRef Then
|
||||
aField.Copy
|
||||
Call aField.Select
|
||||
Call theDoc.Application.Selection.Range.PasteAndFormat(wdFormatPlainText)
|
||||
End If
|
||||
Next aField
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_InsertObject()
|
||||
Dim target As Word.Range: Set target = ActiveDocument.ActiveWindow.Selection.Range.Paragraphs.First.Range
|
||||
Call CDD_AddPict.Show
|
||||
Select Case CDD_AddPict.Flag
|
||||
Case 0: Call InsertConceptSymbol(target, CDD_AddPict.Choice)
|
||||
Case 1: Call InsertPictureRef(target, CDD_AddPict.Bookmark)
|
||||
Case 2: Call InsertNewPicture(CDD_AddPict.PicAdd, target)
|
||||
Case 3: Call InsertTextField(target, CDD_AddPict.LighterText)
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_InlineObjects()
|
||||
Dim target As Word.Range: Set target = ActiveDocument.ActiveWindow.Selection.Paragraphs.First.Range.Duplicate
|
||||
Dim nShape&
|
||||
For nShape = 1 To target.InlineShapes.Count Step 1
|
||||
Call InlineAsPNG(target.InlineShapes(nShape))
|
||||
Next nShape
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_CreateBlocking()
|
||||
Dim target As Word.Range: Set target = ActiveDocument.ActiveWindow.Selection.Range
|
||||
If target.Start = target.End Then _
|
||||
Exit Sub
|
||||
Call CreateLayoutBlock(target)
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_ScaleFont()
|
||||
Dim theDoc As Word.Document: Set theDoc = ActiveDocument
|
||||
|
||||
Call CDD_FontScaling.Init
|
||||
Call CDD_FontScaling.Show
|
||||
|
||||
If Not CDD_FontScaling.isCancelled_ Then _
|
||||
Call ExecuteRedesign(theDoc, CDD_FontScaling.SumUp)
|
||||
|
||||
Call Unload(CDD_FontScaling)
|
||||
End Sub
|
||||
|
||||
Public Sub CDA_Help()
|
||||
MsgBox "TODO"
|
||||
End Sub
|
||||
|
||||
' =======
|
||||
Private Function RunPaintTableProto(target As Word.Range, tableCount&, proto As Word.Table)
|
||||
Call CSE_ProgressBar.Init("Ïîêðàñêà òàáëèö", sHeader:="Ðàáîòàåì...", maxVal:=tableCount, canInterrupt:=True)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
Dim nTable&
|
||||
For nTable = 1 To tableCount Step 1
|
||||
Dim aTable As Word.Table: Set aTable = target.Tables(nTable)
|
||||
If aTable.Range.Start = proto.Range.Start Then _
|
||||
GoTo NEXT_TABLE
|
||||
|
||||
Call PaintTableProto(aTable, proto)
|
||||
|
||||
NEXT_TABLE:
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
If CSE_ProgressBar.Interrupted Then _
|
||||
nTable = tableCount
|
||||
Next nTable
|
||||
|
||||
Call Unload(CSE_ProgressBar)
|
||||
End Function
|
||||
|
||||
Private Function RunPaintTable(target As Word.Range, tableCount&, props As TablePaintProps)
|
||||
Dim tablCount&: tablCount = Selection.Tables.Count
|
||||
|
||||
Call CSE_ProgressBar.Init("Ïîêðàñêà òàáëèö", sHeader:="Èçìåíåíèå ïàðàìåòðîâ òàáëèö...", maxVal:=tablCount, canInterrupt:=True)
|
||||
Call CSE_ProgressBar.ShowModeless
|
||||
|
||||
Dim nTable&
|
||||
For nTable = 1 To tableCount Step 1
|
||||
Dim aTable As Word.Table: Set aTable = target.Tables(nTable)
|
||||
Dim headRange As Word.Range: Set headRange = GetSectionHeader(aTable.Range.Start, target.Document)
|
||||
If headRange Is Nothing Then _
|
||||
GoTo NEXT_TABLE
|
||||
|
||||
Call PaintTable(aTable, headRange.Font.Color, props)
|
||||
|
||||
NEXT_TABLE:
|
||||
Call CSE_ProgressBar.IncrementA
|
||||
If CSE_ProgressBar.Interrupted Then _
|
||||
nTable = tableCount
|
||||
Next nTable
|
||||
|
||||
Call Unload(CSE_ProgressBar)
|
||||
End Function
|
||||
6
src/MainImpl.bas
Normal file
6
src/MainImpl.bas
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
Attribute VB_Name = "MainImpl"
|
||||
Option Explicit
|
||||
|
||||
|
||||
' =============
|
||||
|
||||
152
src/dialogs/CDD_AddPict.frm
Normal file
152
src/dialogs/CDD_AddPict.frm
Normal file
|
|
@ -0,0 +1,152 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CDD_AddPict
|
||||
Caption = "Âñòàâêà îáúåêòà íà ïîëå"
|
||||
ClientHeight = 7530
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 10155
|
||||
OleObjectBlob = "CDD_AddPict.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
Attribute VB_Name = "CDD_AddPict"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
' TODO: isCancelled_ and extract logic
|
||||
|
||||
Private m_NewPict As String
|
||||
Private m_chsnSymb As String
|
||||
Private m_icnCells As Collection
|
||||
|
||||
Private Const INIT_POS_BG As Integer = 0
|
||||
Private Const INIT_POS_BK As Integer = -90
|
||||
Private Const INIT_POS_G As Integer = 12
|
||||
|
||||
Public Property Get Flag() As Integer
|
||||
Flag = Selector.Value
|
||||
End Property
|
||||
|
||||
Public Property Get Bookmark() As String
|
||||
Bookmark = Me.ListBox.Value
|
||||
End Property
|
||||
|
||||
Public Property Get LighterText() As String
|
||||
LighterText = LighterBox.Text
|
||||
End Property
|
||||
|
||||
Public Property Get PicAdd() As String
|
||||
PicAdd = m_NewPict
|
||||
End Property
|
||||
|
||||
Public Property Get Choice() As String
|
||||
Choice = m_chsnSymb
|
||||
End Property
|
||||
|
||||
Public Property Let Choice(retVal$)
|
||||
m_chsnSymb = retVal
|
||||
End Property
|
||||
|
||||
Private Sub CmdADD_Click()
|
||||
Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub cmdAddEx_Click()
|
||||
Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub CmdLighter_Click()
|
||||
Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub ListBox_Change()
|
||||
Dim tmp As Word.Range: Set tmp = Selection.Range
|
||||
Dim oper As Word.InlineShape: Set oper = ActiveDocument.Bookmarks(ListBox.Value).Range.InlineShapes(1)
|
||||
Dim x As Double, y As Double, bln As Boolean
|
||||
With oper
|
||||
x = oper.Height
|
||||
y = oper.Width
|
||||
bln = Application.ScreenUpdating
|
||||
Application.ScreenUpdating = False
|
||||
oper.Height = CentimetersToPoints(6) * x / y
|
||||
oper.Width = CentimetersToPoints(6)
|
||||
Call oper.Select
|
||||
Call Selection.CopyAsPicture
|
||||
oper.Height = x
|
||||
oper.Width = y
|
||||
Application.ScreenUpdating = bln
|
||||
End With
|
||||
Set Me.PrevEx.Picture = PastePicture(xlBitmap)
|
||||
Call tmp.Select
|
||||
End Sub
|
||||
|
||||
Private Sub ListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
|
||||
If ListBox.ListIndex <> -1 Then Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub Srch_Click()
|
||||
m_NewPict = UserInteraction.PromptFile("")
|
||||
Set PrevNew.Picture = LoadPictureGDI(m_NewPict)
|
||||
Me.AddressBox.Text = m_NewPict
|
||||
End Sub
|
||||
|
||||
Private Sub UserForm_Initialize()
|
||||
Selector.Value = 0
|
||||
Set m_icnCells = New Collection
|
||||
Call LabelsFill
|
||||
Call ListFill
|
||||
End Sub
|
||||
|
||||
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
|
||||
End
|
||||
End Sub
|
||||
|
||||
Private Function ListFill()
|
||||
Dim curDoc As Word.Document: Set curDoc = ActiveDocument
|
||||
Call Me.ListBox.Clear
|
||||
|
||||
Dim tmpMrk As Word.Bookmark
|
||||
For Each tmpMrk In curDoc.Bookmarks
|
||||
If Left(tmpMrk.Name, 5) = "pict_" Then _
|
||||
Me.ListBox.AddItem (tmpMrk.Name)
|
||||
Next tmpMrk
|
||||
End Function
|
||||
|
||||
Private Function LabelsFill()
|
||||
Dim i%
|
||||
Dim tmpCell As IconPicker
|
||||
Dim tmpTop As MSForms.Label
|
||||
Dim tmpNme As MSForms.Label
|
||||
|
||||
For i = 1 To 250
|
||||
On Error Resume Next
|
||||
|
||||
Set tmpTop = Me.FramePict.Controls("Label" & 2 * i - 1)
|
||||
If tmpTop.Parent.Parent.Name <> Selector.Pages.Item(0).Name Then GoTo SKP_NCELL
|
||||
Set tmpNme = Me.FramePict.Controls("Label" & 2 * i)
|
||||
If tmpNme.Parent.Parent.Name <> Selector.Pages.Item(0).Name Then GoTo SKP_NCELL
|
||||
If Err.Number <> 0 Then GoTo SKP_NCELL
|
||||
|
||||
Select Case i
|
||||
Case Is <= 50: tmpTop.Caption = chrW(96 + i)
|
||||
Case Is <= 100: tmpTop.Caption = chrW(64 + i - 50)
|
||||
Case Is <= 150:
|
||||
tmpTop.Font.Charset = 204
|
||||
tmpTop.Caption = chrW(val("&H" & 429 + i - 100)) '!!! ÏÎÌÅÍßÒÜ ÄÈÀÏÀÇÎÍ
|
||||
Case Is <= 200: tmpTop.Caption = chrW(val("&H" & 250 + i - 150))
|
||||
Case Is <= 250: tmpTop.Caption = chrW(val("&H" & 530 + i - 200))
|
||||
End Select
|
||||
|
||||
tmpTop.Font.Name = "conceptpict"
|
||||
|
||||
Set tmpCell = New IconPicker
|
||||
Call tmpCell.AssignControls(Me, tmpTop, tmpNme)
|
||||
Call m_icnCells.Add(tmpCell)
|
||||
|
||||
SKP_NCELL:
|
||||
Err.Clear
|
||||
Next i
|
||||
On Error GoTo 0
|
||||
End Function
|
||||
BIN
src/dialogs/CDD_AddPict.frx
Normal file
BIN
src/dialogs/CDD_AddPict.frx
Normal file
Binary file not shown.
41
src/dialogs/CDD_AutoDesign.frm
Normal file
41
src/dialogs/CDD_AutoDesign.frm
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CDD_AutoDesign
|
||||
Caption = "Ïàðàìåòðû àâòîìàêåòèðîâàíèÿ"
|
||||
ClientHeight = 3180
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 3585
|
||||
OleObjectBlob = "CDD_AutoDesign.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
Attribute VB_Name = "CDD_AutoDesign"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public isCancelled_ As Boolean
|
||||
|
||||
Private Sub UserForm_Initialize()
|
||||
isCancelled_ = True
|
||||
End Sub
|
||||
|
||||
Public Function Init()
|
||||
isCancelled_ = True
|
||||
End Function
|
||||
|
||||
Private Sub cmdAutoDesing_Click()
|
||||
isCancelled_ = False
|
||||
Me.Hide
|
||||
End Sub
|
||||
|
||||
Public Property Get Preferences() As AutoDesignOptions
|
||||
Preferences.reapplyLists = Me.ckReStyleNum.Value
|
||||
Preferences.fixObjects = Me.ckInline.Value
|
||||
Preferences.doLayout = Me.ckAlign.Value
|
||||
Preferences.generateColontitles = Me.ckColont.Value
|
||||
Preferences.titlePage = Me.ckTitle.Value
|
||||
Preferences.Count = Abs(Me.ckInline.Value + Me.ckAlign.Value _
|
||||
+ Me.ckColont.Value + Me.ckTitle.Value + Me.ckReStyleNum.Value)
|
||||
End Property
|
||||
BIN
src/dialogs/CDD_AutoDesign.frx
Normal file
BIN
src/dialogs/CDD_AutoDesign.frx
Normal file
Binary file not shown.
75
src/dialogs/CDD_FontScaling.frm
Normal file
75
src/dialogs/CDD_FontScaling.frm
Normal file
|
|
@ -0,0 +1,75 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CDD_FontScaling
|
||||
Caption = "Èçìåíåíèå øðèôòîâ"
|
||||
ClientHeight = 2385
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 6360
|
||||
OleObjectBlob = "CDD_FontScaling.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
Attribute VB_Name = "CDD_FontScaling"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private Const m_BaseSize As Double = 11
|
||||
Private Const m_BaseInter As Double = 1
|
||||
|
||||
Dim m_nSize As Double
|
||||
Dim m_Inter As Double
|
||||
Dim m_FontScale As Double
|
||||
|
||||
Public isCancelled_ As Boolean
|
||||
|
||||
Private Sub UserForm_Initialize()
|
||||
isCancelled_ = True
|
||||
Call Me.FontList.Clear
|
||||
Call Me.FontList.AddItem("Times New Roman")
|
||||
Me.FontList.Value = FontList.List(0)
|
||||
End Sub
|
||||
|
||||
Public Function Init()
|
||||
isCancelled_ = True
|
||||
End Function
|
||||
|
||||
Private Sub cmdLonely_Click()
|
||||
isCancelled_ = False
|
||||
Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub FontList_Change()
|
||||
Call Update
|
||||
End Sub
|
||||
|
||||
Private Sub InterSpin_Change()
|
||||
Call Update
|
||||
End Sub
|
||||
|
||||
Private Sub SizeSpin_Change()
|
||||
Call Update
|
||||
End Sub
|
||||
|
||||
Private Function Update()
|
||||
m_nSize = m_BaseSize + Me.SizeSpin.Value / 2
|
||||
m_Inter = m_BaseInter + Me.InterSpin.Value / 20
|
||||
|
||||
Me.NewLbl.Font.Size = m_nSize
|
||||
Me.tbNSize.Text = m_nSize
|
||||
Me.interSize = m_Inter
|
||||
|
||||
Select Case Me.FontList.Value
|
||||
Case "Times New Roman": m_FontScale = 1.15
|
||||
End Select
|
||||
End Function
|
||||
|
||||
Public Function SumUp() As ItemFontScale
|
||||
Set SumUp = New ItemFontScale
|
||||
SumUp.fontMultiplier_ = m_nSize / m_BaseSize
|
||||
SumUp.lineSpacing_ = m_nSize * m_FontScale * m_Inter
|
||||
SumUp.fontFactor_ = m_FontScale
|
||||
SumUp.spacing_ = m_Inter
|
||||
SumUp.textSize_ = m_nSize
|
||||
End Function
|
||||
BIN
src/dialogs/CDD_FontScaling.frx
Normal file
BIN
src/dialogs/CDD_FontScaling.frx
Normal file
Binary file not shown.
103
src/dialogs/CDD_HeaderFooter.frm
Normal file
103
src/dialogs/CDD_HeaderFooter.frm
Normal file
|
|
@ -0,0 +1,103 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CDD_HeaderFooter
|
||||
Caption = "Îïðåäåëèòå ñîäåðæàíèå êîëîíòèòóëîâ"
|
||||
ClientHeight = 6645
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 6375
|
||||
OleObjectBlob = "CDD_HeaderFooter.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
Attribute VB_Name = "CDD_HeaderFooter"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public isCancelled_ As Boolean
|
||||
|
||||
Private Sub UserForm_Initialize()
|
||||
isCancelled_ = True
|
||||
End Sub
|
||||
|
||||
Public Function Init(target As Word.Document, doCreds As Boolean)
|
||||
isCancelled_ = True
|
||||
|
||||
TextBegin.Value = 3
|
||||
TextEnd.Value = target.Sections.Count - 1
|
||||
|
||||
Call FillCombo(ComboLU, doCreds)
|
||||
Call FillCombo(ComboRU, doCreds)
|
||||
Call FillCombo(ComboLD, doCreds)
|
||||
Call FillCombo(ComboRD, doCreds)
|
||||
|
||||
ComboLU.Value = IIf(doCreds, "Òîì", ComboLU.List(0))
|
||||
ComboRU.Value = IIf(doCreds, "Êíèãà", ComboRU.List(0))
|
||||
ComboLD.Value = "ÊÎÍÖÅÏÒ"
|
||||
ComboRD.Value = "Ðàçäåë"
|
||||
End Function
|
||||
|
||||
Private Sub ButtCancel_Click()
|
||||
isCancelled_ = True
|
||||
Call Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub ButtFix_Click()
|
||||
isCancelled_ = False
|
||||
Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub TextBoxEnd_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
|
||||
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
|
||||
End Sub
|
||||
|
||||
Private Sub TextBoxBegin_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
|
||||
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
|
||||
End Sub
|
||||
|
||||
Private Function FillCombo(cmbBox As control, doCreds As Boolean)
|
||||
With cmbBox
|
||||
Call .Clear
|
||||
If cmbBox.Name = "ComboLU" Or cmbBox.Name = "ComboRU" Then
|
||||
If doCreds Then
|
||||
Call .AddItem("Òîì")
|
||||
Call .AddItem("Êíèãà")
|
||||
End If
|
||||
Call .AddItem("Ãëàâà")
|
||||
End If
|
||||
|
||||
Call .AddItem("Äîêóìåíò")
|
||||
Call .AddItem("Ðàçäåë")
|
||||
Call .AddItem("ÊÎÍÖÅÏÒ")
|
||||
End With
|
||||
End Function
|
||||
|
||||
Private Function TextToType(aText$) As TSource
|
||||
Select Case aText
|
||||
Case "Êíèãà": TextToType = T_SOURCE_BOOK
|
||||
Case "Òîì": TextToType = T_SOURCE_VOLUME
|
||||
Case "Äîêóìåíò": TextToType = T_SOURCE_DOCUMENT
|
||||
Case "Ðàçäåë": TextToType = T_SOURCE_SECTION
|
||||
Case "Ãëàâà": TextToType = T_SOURCE_CHAPTER
|
||||
Case "ÊÎÍÖÅÏÒ": TextToType = T_SOURCE_CONCEPT
|
||||
End Select
|
||||
End Function
|
||||
|
||||
Public Property Get Data() As ItemColontitles
|
||||
Set Data = New ItemColontitles
|
||||
With Data
|
||||
.mTopLeft = TextToType(ComboLU.Value)
|
||||
.mTopRight = TextToType(ComboRU.Value)
|
||||
.mBottomLeft = TextToType(ComboLD.Value)
|
||||
.mBottomRight = TextToType(ComboRD.Value)
|
||||
|
||||
.doTopLeft = ckLU.Value
|
||||
.doTopRight = ckLD.Value
|
||||
.doBottomLeft = ckRU.Value
|
||||
.doBottomRight = ckRD.Value
|
||||
|
||||
.start_ = CLng(TextBegin.Value)
|
||||
.finish_ = CLng(TextEnd.Value)
|
||||
End With
|
||||
End Property
|
||||
BIN
src/dialogs/CDD_HeaderFooter.frx
Normal file
BIN
src/dialogs/CDD_HeaderFooter.frx
Normal file
Binary file not shown.
51
src/dialogs/CDD_Paint.frm
Normal file
51
src/dialogs/CDD_Paint.frm
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CDD_Paint
|
||||
Caption = "Ïîêðàñêà"
|
||||
ClientHeight = 2760
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 2610
|
||||
OleObjectBlob = "CDD_Paint.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
Attribute VB_Name = "CDD_Paint"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public isCancelled_ As Boolean
|
||||
|
||||
Private Sub UserForm_Initialize()
|
||||
isCancelled_ = True
|
||||
End Sub
|
||||
|
||||
Public Function Init()
|
||||
isCancelled_ = True
|
||||
End Function
|
||||
|
||||
Public Property Get DoText() As Boolean
|
||||
DoText = cbPart.Value
|
||||
End Property
|
||||
|
||||
Public Property Get DoLinks() As Boolean
|
||||
DoLinks = cbHLs.Value
|
||||
End Property
|
||||
|
||||
Public Property Get DoFields() As Boolean
|
||||
DoFields = cbOuts.Value
|
||||
End Property
|
||||
|
||||
Public Property Get DoToC() As Boolean
|
||||
DoToC = cbCont.Value
|
||||
End Property
|
||||
|
||||
Public Property Get Count() As Long
|
||||
Count = DoToC + DoText + DoLinks + DoFields
|
||||
End Property
|
||||
|
||||
Private Sub btOk_Click()
|
||||
isCancelled_ = False
|
||||
Me.Hide
|
||||
End Sub
|
||||
BIN
src/dialogs/CDD_Paint.frx
Normal file
BIN
src/dialogs/CDD_Paint.frx
Normal file
Binary file not shown.
62
src/dialogs/CDD_RunAudit.frm
Normal file
62
src/dialogs/CDD_RunAudit.frm
Normal file
|
|
@ -0,0 +1,62 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CDD_RunAudit
|
||||
Caption = "Îòìåòèòü â òåêñòå"
|
||||
ClientHeight = 3720
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 3060
|
||||
OleObjectBlob = "CDD_RunAudit.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
Attribute VB_Name = "CDD_RunAudit"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public isCancelled_ As Boolean
|
||||
|
||||
Private Sub UserForm_Initialize()
|
||||
isCancelled_ = True
|
||||
End Sub
|
||||
|
||||
Public Function Init()
|
||||
isCancelled_ = True
|
||||
End Function
|
||||
|
||||
Private Sub rGo_Click()
|
||||
isCancelled_ = False
|
||||
Me.Hide
|
||||
End Sub
|
||||
|
||||
Public Property Get DoHeaders() As Boolean
|
||||
DoHeaders = r1.Value
|
||||
End Property
|
||||
|
||||
Public Property Get DoPar() As Boolean
|
||||
DoPar = r2.Value
|
||||
End Property
|
||||
|
||||
Public Property Get DoDash() As Boolean
|
||||
DoDash = r3.Value
|
||||
End Property
|
||||
|
||||
Public Property Get DoFields() As Boolean
|
||||
DoFields = r4.Value
|
||||
End Property
|
||||
|
||||
Public Property Get DoListNums() As Boolean
|
||||
DoListNums = r5.Value
|
||||
End Property
|
||||
|
||||
Public Property Get DoPict() As Boolean
|
||||
DoPict = r6.Value
|
||||
End Property
|
||||
|
||||
Public Property Get CountRules() As Integer
|
||||
Dim i&
|
||||
For i = 1 To 6
|
||||
CountRules = CountRules + IIf(Me.Controls("r" & i).Value, 1, 0)
|
||||
Next i
|
||||
End Property
|
||||
BIN
src/dialogs/CDD_RunAudit.frx
Normal file
BIN
src/dialogs/CDD_RunAudit.frx
Normal file
Binary file not shown.
128
src/dialogs/CDD_TableColors.frm
Normal file
128
src/dialogs/CDD_TableColors.frm
Normal file
|
|
@ -0,0 +1,128 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CDD_TableColors
|
||||
Caption = "Óñòàíîâèòå íàñòðîéêè òàáëèö"
|
||||
ClientHeight = 3945
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 7935
|
||||
OleObjectBlob = "CDD_TableColors.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
Attribute VB_Name = "CDD_TableColors"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Private eventsOn_ As Boolean
|
||||
|
||||
Private props_ As TablePaintProps
|
||||
|
||||
Public isCancelled_ As Boolean
|
||||
|
||||
Private Sub UserForm_Initialize()
|
||||
isCancelled_ = True
|
||||
End Sub
|
||||
|
||||
Public Function Init(theColor&)
|
||||
eventsOn_ = True
|
||||
isCancelled_ = True
|
||||
|
||||
props_.sectionColor = theColor
|
||||
props_.cGrid = 1000 * -0.35
|
||||
props_.cHeading = 1000 * 0.2
|
||||
props_.cSubHead = 1000 * 0.35
|
||||
props_.cZebra = 1000 * 0.8
|
||||
|
||||
ltp.BackColor = theColor
|
||||
|
||||
Call UpdateFM
|
||||
End Function
|
||||
|
||||
Public Property Get TableProperties() As TablePaintProps
|
||||
TableProperties = props_
|
||||
End Property
|
||||
|
||||
Private Function UpdateFM()
|
||||
eventsOn_ = False
|
||||
bodB.Value = props_.cGrid
|
||||
headB.Value = props_.cHeading
|
||||
subB.Value = props_.cSubHead
|
||||
zerB.Value = props_.cZebra
|
||||
|
||||
LS.BackColor = ColorAdjustLuma(props_.sectionColor, props_.cSubHead, True)
|
||||
LH.BackColor = ColorAdjustLuma(props_.sectionColor, props_.cHeading, True)
|
||||
LZ.BackColor = ColorAdjustLuma(props_.sectionColor, props_.cZebra, True)
|
||||
LF.BackColor = ColorAdjustLuma(props_.sectionColor, props_.cGrid, True)
|
||||
|
||||
Dim greyCol&
|
||||
|
||||
lf1.BackColor = LF.BackColor
|
||||
ls1.BackColor = LS.BackColor
|
||||
lh1.BackColor = LH.BackColor
|
||||
lh2.BackColor = LH.BackColor
|
||||
|
||||
greyCol = ColorGetLuma(LZ.BackColor)
|
||||
l2.BackColor = IIf(greyCol < 127, RGB(255, 255, 255), RGB(0, 0, 0))
|
||||
l4.BackColor = IIf(greyCol < 127, RGB(255, 255, 255), RGB(0, 0, 0))
|
||||
l6.BackColor = IIf(greyCol < 127, RGB(255, 255, 255), RGB(0, 0, 0))
|
||||
l8.BackColor = IIf(greyCol < 127, RGB(255, 255, 255), RGB(0, 0, 0))
|
||||
|
||||
l2.BackColor = LZ.BackColor
|
||||
l4.BackColor = LZ.BackColor
|
||||
l6.BackColor = LZ.BackColor
|
||||
l8.BackColor = LZ.BackColor
|
||||
|
||||
greyCol = ColorGetLuma(LH.BackColor)
|
||||
lh1.ForeColor = IIf(greyCol < 127, RGB(255, 255, 255), RGB(0, 0, 0))
|
||||
lh2.ForeColor = IIf(greyCol < 127, RGB(255, 255, 255), RGB(0, 0, 0))
|
||||
|
||||
greyCol = ColorGetLuma(props_.sectionColor)
|
||||
ltp.ForeColor = IIf(greyCol < 127, RGB(255, 255, 255), RGB(0, 0, 0))
|
||||
|
||||
greyCol = ColorGetLuma(LS.BackColor)
|
||||
ls1.ForeColor = IIf(greyCol < 127, RGB(255, 255, 255), RGB(0, 0, 0))
|
||||
|
||||
props_.textSpacing = Spin.Value / 10
|
||||
|
||||
eventsOn_ = True
|
||||
End Function
|
||||
|
||||
Private Sub bodB_Change()
|
||||
If Not eventsOn_ Then _
|
||||
Exit Sub
|
||||
props_.cGrid = bodB.Value
|
||||
Call UpdateFM
|
||||
End Sub
|
||||
|
||||
Private Sub headB_Change()
|
||||
If Not eventsOn_ Then _
|
||||
Exit Sub
|
||||
props_.cHeading = headB.Value
|
||||
Call UpdateFM
|
||||
End Sub
|
||||
|
||||
Private Sub okBTN_Click()
|
||||
isCancelled_ = False
|
||||
Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub Spin_Change()
|
||||
txtSpc.Value = "0." & Spin.Value
|
||||
props_.textSpacing = Spin.Value / 10
|
||||
End Sub
|
||||
|
||||
Private Sub subB_Change()
|
||||
If Not eventsOn_ Then _
|
||||
Exit Sub
|
||||
props_.cSubHead = subB.Value
|
||||
Call UpdateFM
|
||||
End Sub
|
||||
|
||||
Private Sub zerB_Change()
|
||||
If Not eventsOn_ Then _
|
||||
Exit Sub
|
||||
props_.cZebra = zerB.Value
|
||||
Call UpdateFM
|
||||
End Sub
|
||||
BIN
src/dialogs/CDD_TableColors.frx
Normal file
BIN
src/dialogs/CDD_TableColors.frx
Normal file
Binary file not shown.
46
src/dialogs/CDD_TablePrototype.frm
Normal file
46
src/dialogs/CDD_TablePrototype.frm
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CDD_TablePrototype
|
||||
Caption = "Âûáåðèòå ïðîòîòèï"
|
||||
ClientHeight = 1620
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 3525
|
||||
OleObjectBlob = "CDD_TablePrototype.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
Attribute VB_Name = "CDD_TablePrototype"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
||||
Option Explicit
|
||||
|
||||
Public isCancelled_ As Boolean
|
||||
|
||||
Private Sub UserForm_Initialize()
|
||||
isCancelled_ = True
|
||||
End Sub
|
||||
|
||||
Public Function Init(nId&)
|
||||
isCancelled_ = True
|
||||
TextBox1.Text = Trim(Str(nId))
|
||||
End Function
|
||||
|
||||
Public Property Get applyToAll() As Boolean
|
||||
applyToAll = CheckBox1.Value
|
||||
End Property
|
||||
|
||||
Public Property Get GetPickedID() As Long
|
||||
GetPickedID = CLng(TextBox1.Text)
|
||||
End Property
|
||||
|
||||
Private Sub okBTN_Click()
|
||||
isCancelled_ = False
|
||||
Me.Hide
|
||||
End Sub
|
||||
|
||||
Private Sub CancelBtn_Click()
|
||||
isCancelled_ = True
|
||||
Me.Hide
|
||||
End Sub
|
||||
|
||||
BIN
src/dialogs/CDD_TablePrototype.frx
Normal file
BIN
src/dialogs/CDD_TablePrototype.frx
Normal file
Binary file not shown.
70
src/z_UIMessages.bas
Normal file
70
src/z_UIMessages.bas
Normal file
|
|
@ -0,0 +1,70 @@
|
|||
Attribute VB_Name = "z_UIMessages"
|
||||
' Messaging module
|
||||
Option Private Module
|
||||
Option Explicit
|
||||
|
||||
Public Enum MsgCode
|
||||
EM_TABLE_NOT_SELECTED
|
||||
EM_TABLE_MERGED_CELLS
|
||||
EM_TABLE_OUTSIDE_SECTION
|
||||
EM_INVALID_CONTENTS_TABLE
|
||||
EM_CANNOT_INSERT_IMAGE
|
||||
EM_FIX_LINING_FAIL
|
||||
EM_INVALID_TABLE_COLUMNS
|
||||
|
||||
IM_AUTODESIGN_OK
|
||||
IM_FIX_LINES_OK
|
||||
IM_REPAINT_OK
|
||||
IM_FOOTER_OK
|
||||
IM_FIX_BOOKMARK_NAME
|
||||
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_TABLE_NOT_SELECTED: Call MsgBox("Âûáåðèòå òàáëèöó!", vbExclamation)
|
||||
Case EM_TABLE_MERGED_CELLS: Call MsgBox("Òàáëèöà íå äîëæíà ñîäåðæàòü âåðòèêàëüíî îáúåäèí¸ííûõ ÿ÷ååê", vbCritical)
|
||||
Case EM_TABLE_OUTSIDE_SECTION: Call MsgBox("Íåâîçìîæíî ïîêðàñèòü òàáëèöó âíå ðàçäåëà", vbExclamation)
|
||||
Case EM_INVALID_CONTENTS_TABLE: Call MsgBox("Îãëàâëåíèå êîí÷èëîñü ðàíüøå çàãîëîâêîâ! Îáíîâèòå îãëàâëåíèå!", vbExclamation)
|
||||
Case EM_CANNOT_INSERT_IMAGE: Call MsgBox("Íåâîçìîæíî âñòàâèòü ôàéë êàðòèíêè!", vbCritical)
|
||||
Case EM_FIX_LINING_FAIL: Call MsgBox("Îøèáêà ïðè ïîäãîíå èíòåðâàëà, îáðàòèòåñü ê ðàçðàáîò÷èêó!", vbCritical)
|
||||
Case EM_INVALID_TABLE_COLUMNS: Call MsgBox("Â òàáëèöå ìèíèìóì 2 ñòîëáöà", vbCritical)
|
||||
|
||||
Case IM_AUTODESIGN_OK: Call MsgBox("Ìàêåò ñãåíåðèðîâàí", vbInformation)
|
||||
Case IM_FIX_LINES_OK: Call MsgBox("Áàëàíñèðîâàíèå ñòðîê çàâåðøåíî óñïåøíî", vbInformation)
|
||||
Case IM_REPAINT_OK: Call MsgBox("Ïîêðàñêà ïðîèçâåäåíà óñïåøíî!", vbInformation)
|
||||
Case IM_FOOTER_OK: Call MsgBox("Âñå êîëîíòèòóëû óñïåøíî ôîðìàòèðîâàíû!", vbInformation)
|
||||
Case IM_FIX_BOOKMARK_NAME: Call MsgBox(Fmt("Íåêîððåêòíîå èìÿ, èçìåíåíî íà {1}", 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
|
||||
31
src/z_UIRibbon.bas
Normal file
31
src/z_UIRibbon.bas
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
Attribute VB_Name = "z_UIRibbon"
|
||||
Option Explicit
|
||||
|
||||
Sub CCD_OnRibbonBtn(iControl As IRibbonControl)
|
||||
Select Case iControl.ID
|
||||
Case "AutoDesign": Call CDA_AutoDesign
|
||||
Case "FixLines": Call CDA_FixLines
|
||||
Case "ColorAll": Call CDA_Repaint
|
||||
Case "PaintTable": Call CDA_PaintTable
|
||||
Case "AddPict": Call CDA_InsertObject
|
||||
|
||||
Case "FooterHeaderMaster": Call CDA_FooterHeader
|
||||
Case "IntBlock": Call CDA_CreateBlocking
|
||||
Case "UpdTOC": Call CDA_UpdateToC
|
||||
|
||||
Case "InsertHeader": Call CDA_InsertHeader
|
||||
Case "InsertPageBreak": Call CDA_InsertBreak
|
||||
|
||||
Case "InlinePNG": Call CDA_InlineObjects
|
||||
Case "InlineFields": Call CDA_InlineFields
|
||||
Case "ScaleFont": Call CDA_ScaleFont
|
||||
|
||||
Case "TS_Align": Call CDA_TSAlign
|
||||
Case "TS_Slice": Call CDA_TSSlice
|
||||
Case "TS_Paint": Call CDA_TSPaint
|
||||
|
||||
Case "AuditDesign": Call CDA_Audit
|
||||
|
||||
Case "Help": Call CDA_Help
|
||||
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>
|
||||
98
ui/customUI.xml
Normal file
98
ui/customUI.xml
Normal file
|
|
@ -0,0 +1,98 @@
|
|||
<?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="Design" label="Макетирование" imageMso="PageColorPicker">
|
||||
<button id="FixLines" size="large"
|
||||
label="Баланс строк"
|
||||
supertip="Скорректировать баланс строк в заголовках и положения объектов на полях"
|
||||
imageMso="PivotTableLayoutReportLayout"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="ColorAll" size="large"
|
||||
label="Обновить цвета"
|
||||
supertip="Применить цветовую схему к документу"
|
||||
imageMso="AppointmentColorDialog"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
|
||||
<menu id="DesignElementsMenu" label="Элементы" imageMso="ChartColorsGallery" size="large">
|
||||
<button id="AddPict" label="Вставить на поле"
|
||||
supertip="Добавить пиктограмму, рисунок или текст на поля"
|
||||
imageMso="PictureStylesGallery"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="InsertHeader" label="Заголовок"
|
||||
supertip="Добавить нумерованный подзаголовок"
|
||||
imageMso="ReviewBalloonsMenu"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="UpdTOC" label="Оглавление"
|
||||
supertip="Обновить текст и цвета оглавления"
|
||||
imageMso="SlideMasterTextPlaceholderInsert"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="FooterHeaderMaster" label="Колонтитулы"
|
||||
supertip="Автоматически проставить колонтитулы"
|
||||
imageMso="PostcardWizard"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
</menu>
|
||||
|
||||
<menu id="DesignTransformMenu" label="Morph" imageMso="AdpManageIndexes" size="large">
|
||||
<button id="IntBlock" label="Блок"
|
||||
supertip="Подгон отступов выделенного фрагмента для формирования блока в двухколоночном разделе"
|
||||
imageMso="ViewGridlinesFrontPage"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="InsertPageBreak" label="Разрыв"
|
||||
supertip="Вставить разрыв колонок"
|
||||
imageMso="GroupBlogPublish"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="InlinePNG" label="PNG"
|
||||
supertip ="Конвертировать изображения абзаца в PNG"
|
||||
imageMso="PictureChange"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="InlineFields" label="-Коды"
|
||||
supertip="Замена полей на текст"
|
||||
imageMso="CreateLabels"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="ScaleFont" label="Лупа"
|
||||
supertip="Масштабировать макет"
|
||||
imageMso="ViewFullScreenReadingView"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
</menu>
|
||||
|
||||
<menu id="DesignTableMenu" label="Таблица" imageMso="AccessListCustomDatasheet" size="large">
|
||||
<button id="PaintTable" label="Красить таблицу"
|
||||
supertip="Перекрасить выделенную таблицу"
|
||||
imageMso="CreateTableUsingSharePointListsGallery"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="TS_Align" label="Подготовка"
|
||||
supertip="Начать подготовку к нарезанию таблицы на разворот"
|
||||
imageMso="AccessTableEvents"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="TS_Slice" label="Нарезка"
|
||||
supertip="Нарезать таблицу на разворот страниц"
|
||||
imageMso="CreateQueryInDesignView"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="TS_Paint" label="Покраска"
|
||||
supertip="Меню настройки цветов таблицы"
|
||||
imageMso="CopyToPersonalCalendar"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
</menu>
|
||||
|
||||
<button id="AuditDesign" size="large"
|
||||
label="Проверить макет"
|
||||
supertip="Обнаружение некоторых распространённых ошибок в макете"
|
||||
imageMso="ChartResetToMatchStyle"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="AutoDesign" size="large"
|
||||
label="Автомакет"
|
||||
supertip="Создать макет текущего отчета"
|
||||
imageMso="ChangeStylesMenu"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
<button id="Help" size="large"
|
||||
label="Справка"
|
||||
supertip="Вызов справки по надстройкам Word"
|
||||
imageMso="Info"
|
||||
onAction="CCD_OnRibbonBtn"/>
|
||||
</group>
|
||||
</tab>
|
||||
</tabs>
|
||||
</ribbon>
|
||||
</customUI>
|
||||
Loading…
Reference in New Issue
Block a user