Я динамически создаю текстовый документ из листа Excel, используя VBA.
Одно из требований заключается в том, чтобы все конкретные абзацы были размещены на одной странице.Другое - то, что определенные разделы должны быть сохранены на той же странице.
Этот проект существует уже много лет, и постоянная разработка вызвала много спагетти-кода, поэтому, пожалуйста, перекусите, прежде чем читать фрагмент кода ниже.
Примечание: скрипт запускается дважды.Один раз, затем я добавляю свои нижние колонтитулы, затем запускаю его снова.
Мне просто нужен фрагмент сценария, который перемещает абзац на следующую страницу, если он обнаруживает, что он занимает две страницы.Получение правильного разбиения страницы было постоянной проблемой «положить лицо сквозь стену», поэтому, пожалуйста, не будьте резкими.
Col C в соглашении: содержит Page_Start (начало нескольких абзацев, которые должны быть на одной странице, а не обязательно в начале страницы), Page_Stop (указывается, что в этой строке содержится последний абзац, который должен бытьположить на ту же страницу) и New_Page (вставить точку останова здесь)
Sub SetPageBreaks()
Dim bPageStart As Boolean
bPageStart = False
Dim sText As String
Dim rngFound As Word.Range
Dim rngContent As Word.Range
Dim sFirst As String
Dim sLast As String
Set rngContent = wd.Content
bPageStart = False
bPageEnd = False
bSkip = False
bNewPage = False
Last_Row = Worksheets("Agreement").Range("A65536").End(xlUp).Row
DoEvents
wd.GrammarChecked = True
wd.SpellingChecked = True
DoEvents
For iRow = 1 To Last_Row
wd.UpdateStyles
sText = Worksheets("Agreement").Range("A" & iRow)
IndentLevel = Worksheets("Agreement").Range("A" & iRow).IndentLevel
If IndentLevel > 0 Then
IndentLevel23 = 4
End If
If sText = "" Then
GoTo NextIteration
End If
If (Worksheets("Agreement").Range("C" & iRow) <> "") Then
Select Case Worksheets("Agreement").Range("C" & iRow)
Case "PAGE_START"
bPageStart = True
bSkip = True
Case "PAGE_STOP"
bPageEnd = True
bSkip = False
Case "New_Page"
bNewPage = True
End Select
End If
If (InStr(sText, vbLf) > 0) Then
'This section is to deal with clauses that have line breaks inside them
sFirst = ""
sLast = ""
Temp = sText
Do While (InStr(Temp, vbLf) > 0)
Temp = Right(Temp, Len(Temp) - InStr(Temp, vbLf))
If Temp <> "" Then
sLast = Temp
Else
sLast = Left(sLast, InStr(sLast, vbLf) - 1)
End If
If sFirst = "" Then
sFirst = Left(sText, InStr(sText, vbLf) - 1)
End If
Loop
'end section
Set rngFirst = FindTextInDoc(sFirst, rngContent)
Set rngFoundStart = wd.Range(rngFirst.Start, rngFirst.Start)
Set rngFound = FindTextInDoc(sLast, rngContent)
Set rngFoundEnd = wd.Range(rngFound.End, rngFound.End)
Else
Set rngFound = FindTextInDoc(sText, rngContent)
Set rngFoundStart = wd.Range(rngFound.Start, rngFound.Start)
Set FndPar = rngFound.Paragraphs(1).Range
Set rngFoundEnd = wd.Range(FndPar.End - 1, FndPar.End - 1)
End If
FirstChar = Left(sText, 1)
ThirdChar = Right(Left(sText, 3), 1)
'This is affects formatting and not page breaks. This code should be relocated.
If (FirstChar = "(" And ThirdChar = ")") Or IndentLevel > 0 Then
With rngFound.ParagraphFormat
.LeftIndent = wdApp.CentimetersToPoints(0.71)
.RightIndent = wdApp.CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 10
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceMultiple
.LineSpacing = wdApp.LinesToPoints(1.15)
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = 0 'CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 4
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
End With
End If
If bNewPage Then
EndPage = wd.Range(rngFoundStart.Start, rngFoundStart.Start).Information(wdActiveEndAdjustedPageNumber)
Set PrvPar = rngFoundStart.Paragraphs(1).Previous(Count:=1).Range
StartPage = PrvPar.Information(wdActiveEndAdjustedPageNumber)
If (EndPage = StartPage) Then
rngFoundStart.Collapse wdCollapseStart
rngFoundStart.InsertBreak wdPageBreak
End If
ElseIf bPageStart Then
Set rngBeg = wd.Range(rngFoundStart.Start, rngFoundStart.Start)
StartPage = rngBeg.Information(wdActiveEndAdjustedPageNumber)
ElseIf bPageEnd Then
Set rngEnd = wd.Range(rngFoundEnd.End - 1, rngFoundEnd.End - 1)
EndPage = rngEnd.Information(wdActiveEndAdjustedPageNumber)
Delta = EndPage - StartPage
If Delta > 0 Then
rngBeg.Collapse wdCollapseStart
rngBeg.InsertBreak wdPageBreak
With wd.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^12[^12^13 ]{1,}"
.Replacement.Text = "^12"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End If
ElseIf Not bSkip Then
Set rngBeg = wd.Range(rngFoundStart.Start, rngFoundStart.Start)
StartPage = rngBeg.Information(wdActiveEndAdjustedPageNumber)
Set rngEnd = wd.Range(rngFoundEnd.End - 1, rngFoundEnd.End - 1)
EndPage = rngEnd.Information(wdActiveEndAdjustedPageNumber)
Delta = EndPage - StartPage
If Delta > 0 Then
rngFoundStart.Collapse wdCollapseStart
rngFoundStart.InsertBreak wdPageBreak
End If
End If
bPageStart = False
bPageEnd = False
bNewPage = False
NextIteration:
Next iRow
j = 1
' Set myRange = wdSig.Paragraphs.Last.Range
' myRange.Collapse Direction:=wdCollapseEnd
' wdSig.Bookmarks.Add _
' Name:="BM" & j, _
' Range:=myRange
DoEvents
wdSig.GrammarChecked = True
wdSig.SpellingChecked = True
DoEvents
Do While (wdSig.Bookmarks.Exists("BM" & j))
pageFirst = wdSig.Bookmarks("BM" & j - 1).Range.Information(wdActiveEndPageNumber)
pageSecond = wdSig.Bookmarks("BM" & j).Range.Information(wdActiveEndPageNumber)
If (pageFirst <> pageSecond) Then
Set wRng = wdSig.Bookmarks("BM" & j - 1).Range
wRng.Collapse wdCollapseStart
wRng.InsertBreak wdPageBreak
End If
j = j + 1
Loop
End Sub