Update 0.4.0

- Add\Rework UI
- Add Split Table and Listing
- Add Support Customazeble schems

scripts/check_page_fill.bas

@@ -0,0 +1,85 @@
+Attribute VB_Name = "CheckPageFill"
+' Heuristic check for half-empty pages inside an unfinished section (MIREA method guide, app. V).
+' Run from Word: Tools → Macro → Macros → CheckPageFill_Run
+' Findings may be FALSE POSITIVES (large figures, end of subsection, odd breaks).
+
+Option Explicit
+
+Private Const EMPTY_THRESHOLD As Double = 0.4
+
+Public Sub CheckPageFill_Run()
+    Dim doc As Document
+    Dim i As Long, n As Long
+    Dim msg As String
+    Dim issues As Long
+    Dim secTitle As String, nextTitle As String
+    Dim emptyFrac As Double
+    Dim contentBottom As Double
+    Dim textH As Double, topM As Double, pageH As Double
+    Dim rng As Range
+    Dim vpos As Double
+
+    Set doc = ActiveDocument
+    doc.Repaginate
+    n = doc.ComputeStatistics(wdStatisticPages)
+    issues = 0
+    msg = "Проверка полупустых страниц (эвристика; возможны ложные срабатывания)" & vbCrLf
+
+    For i = 1 To n
+        Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i
+        If Selection.Sections(1).PageSetup.Orientation = wdOrientLandscape Then GoTo NextPage
+
+        pageH = Selection.Sections(1).PageSetup.PageHeight
+        topM = Selection.Sections(1).PageSetup.TopMargin
+        textH = pageH - topM - Selection.Sections(1).PageSetup.BottomMargin
+        If textH <= 0 Then GoTo NextPage
+
+        Set rng = doc.Bookmarks("\page").Range
+        On Error Resume Next
+        vpos = rng.Information(wdVerticalPositionRelativeToPage)
+        On Error GoTo 0
+        contentBottom = (vpos - topM) / textH
+        If contentBottom < 0 Then contentBottom = 0
+        If contentBottom > 1 Then contentBottom = 1
+        emptyFrac = 1# - contentBottom
+
+        If emptyFrac <= EMPTY_THRESHOLD Then GoTo NextPage
+        If i = n Then GoTo NextPage
+
+        secTitle = HeadingNear(doc, rng.Start)
+        Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i + 1
+        nextTitle = HeadingNear(doc, Selection.Start)
+        If StrComp(secTitle, nextTitle, vbTextCompare) <> 0 Then GoTo NextPage
+        If InStr(1, UCase$(secTitle), "СОДЕРЖАНИЕ", vbTextCompare) > 0 Then GoTo NextPage
+
+        issues = issues + 1
+        msg = msg & "стр. " & i & ": пустой низ ~" & Format(emptyFrac, "0%") & _
+              ", раздел «" & secTitle & "» продолжается" & vbCrLf
+NextPage:
+    Next i
+
+    If issues = 0 Then
+        MsgBox msg & vbCrLf & "Замечаний нет.", vbInformation
+    Else
+        MsgBox msg & vbCrLf & "Всего: " & issues & " (эвристика).", vbExclamation
+    End If
+End Sub
+
+Private Function HeadingNear(doc As Document, pos As Long) As String
+    Dim p As Paragraph
+    Dim s As String
+    On Error Resume Next
+    Set p = doc.Range(pos, pos).Paragraphs(1)
+    Dim k As Long
+    For k = 1 To 80
+        s = p.Style
+        If InStr(1, s, "Heading 1", vbTextCompare) > 0 Or InStr(1, s, "Заголовок 1", vbTextCompare) > 0 Then
+            HeadingNear = Replace(Trim$(p.Range.Text), vbCr, "")
+            Exit Function
+        End If
+        If p.Range.Start <= 1 Then Exit For
+        Set p = p.Previous
+        If p Is Nothing Then Exit For
+    Next k
+    HeadingNear = ""
+End Function