我使用VBA从excel工作表中动态创建Word文档。
其中一项要求是将所有特定段落都放在一页上。 另一个是特定部分需要保留在同一页面上。
这个项目已经存在了很多年，并且持续的开发已经导致了很多意大利面条式的代码，因此请在阅读下面的代码片段之前先咬一下一些东西。
注意：该脚本运行了两次。一次，然后添加页脚，然后再次运行它。
我只需要一个脚本片段，如果它检测到跨两页，则将段落推到下一页。获取正确的分页符一直是“面对面穿墙”的问题，因此请不要苛刻。
协议中的颜色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
答案 0 :(得分：2)
要将所有给定段落保留在同一页面上，请应用“将行保持在一起”属性。当然，如果将“将行保持在一起”应用于内容比页面上容纳的内容多的段落，则在这种情况下将不起作用。
要在同一页面上保留一组段落，请将“保留下一个段落”属性应用于该组中最后一个段落以外的所有段落。当然，如果将“保留下一个”属性应用于超出页面大小的段落，则在这种情况下将不起作用。
这些属性可以一起使用，也可以单独使用。
如果对所有段落应用“将行保持在一起”属性，则没有一个将跨越分页符，因此无需代码来对此进行测试。大概，您已经知道如何识别哪些段落需要分组。