123 lines
3.7 KiB
QBasic
123 lines
3.7 KiB
QBasic
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
|