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