Разрыв страницы на vba для word

I’m trying to insert page break in a Word document with using VBA. But I don’t know why page break only inserted before Page 2 instead of the whole document. Could anyone help? Thank you!

      ABC Company                      Page 1

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

<When «Page» is found, insert page break here>

       ABC Company                      Page 2

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

<When «Page» is found, insert page break here>

       ABC Company                      Page 3

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Code:

    Dim word As Object, doc As Object
        
    Set word = CreateObject("word.application")
    word.Visible = True
    
    word.Documents.Open ("c:report.txt")

    With Selection
        .PageSetup.Orientation = wdOrientLandscape
        .PageSetup.LeftMargin = InchesToPoints("0.5")
        .PageSetup.RightMargin = InchesToPoints("0.5")
        .Font.Size = 9
    End With

    Selection.MoveDown unit:=wdParagraph, Count:=1
    With Selection.Find
        .Forward = True
        .Text = "Page"
        .Replacement.Text = ""
        .Wrap = wdFindContinue
        .Execute
        
        If Selection.Find.Found = True Then
            Selection.StartOf unit:=wdParagraph
            Selection.Collapse Direction:=wdCollapseEnd
            Selection.InsertBreak (wdPageBreak)
            Selection.MoveDown unit:=wdParagraph, Count:=1
        End If
    End With

Источник
  • Remove From My Forums

  • Question

  • I’ve created a new Word document using Visual Basic.  I would just like to know how to insert a page break using Visual Basic.

    Thanks in advance,

    Jim

    James Hutchinson

Answers

  • You could use code like:

    With ActiveDocument.Paragraphs(3).Range
      .Collapse wdCollapseEnd
      .InsertBreak Type:=wdPageBreak
    End With

    Cheers
    Paul Edstein
    [MS MVP — Word]

    • Proposed as answer by

      Tuesday, April 5, 2016 9:19 AM

    • Marked as answer by
      Deepak Saradkumar PanchalMicrosoft contingent staff
      Tuesday, April 5, 2016 9:19 AM

Источник
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252

Option Explicit
 
Const FIRST_ROW& = 28
Const FIRST_COL$ = "J"
Const LAST_COL$ = "P"
Const ITOGO_COL$ = "I"
 
Sub CreatePageSubtotals()
Dim iPageNum&, viewState, hpb As HPageBreak, iRow1&, iRow2&
Dim count_pages As Variant
Dim totalRow As Variant
Dim a As Integer
 
Dim fl As Boolean
Dim rowI As Integer
 
 
Dim R As Range, zoom
Dim wR As Range, Row As Range, C As Range, _
      HrAlg, CurH, NewH
Dim Ar As Range
Dim breakcount As Integer
Dim temp As Double
 
breakcount = ActiveSheet.HPageBreaks.Count
 
Dim CountPages As Integer '????? ?????????? ??????? ??? ??????
    Dim CountRow As Integer '????? ?????????? ?????
    Dim CountCol As Integer '????? ?????????? ????????
    Dim Count1 As Integer '?????????? ??????? ?? ?????????
    Dim Count2 As Integer '?????????? ??????? ?? ???????????
    Dim CountLastPageRow As Integer '????? ?????? ?????? ????? ????????????? ???????? ?? ?????????
    Dim CountLastPageCol As Integer '????? ??????? ?????? ????? ????????????? ???????? ?? ???????????
    CountPages = Worksheets(1).PageSetup.Pages.Count
    CountRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
    CountCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
    Count1 = ActiveSheet.HPageBreaks.Count
    Count2 = ActiveSheet.VPageBreaks.Count
    CountLastPageRow = ActiveSheet.HPageBreaks(ActiveSheet.HPageBreaks.Count).Location.Row - 1
    CountLastPageCol = ActiveSheet.VPageBreaks(ActiveSheet.VPageBreaks.Count).Location.Column - 1
    If Count2 = 1 Then
        If Count1 > 1 Then
            If (CountRow - CountLastPageRow) < 23 Then
                ActiveSheet.HPageBreaks.Add Before:=Cells(CountLastPageRow - 5, 1)
            End If
        End If
    Else
        
    End If
    
    breakcount = ActiveSheet.HPageBreaks.Count
 
 
'Stop
 
rowI = 0
 
'zoom = ActiveSheet.PageSetup.zoom
'ActiveSheet.ResetAllPageBreaks
'ActiveSheet.PageSetup.zoom = zoom
 
Set R = Range("ÈòîãèÏîäïèñè")
  Set R = R.Offset(-1, 0).Resize(R.Rows.Count + 1, R.Columns.Count)
  R.Rows.PageBreak = xlPageBreakNone
  For Each wR In R.Rows
    If wR.PageBreak = xlPageBreakAutomatic Then
      'R.Rows.PageBreak = xlPageBreakManual
      rowI = R.Rows.Row
      'rowI = 1
    End If
  Next
 
 
 
      
' ' àâòîôèò
'Application.ScreenUpdating = False
'Application.EnableEvents = False
'Application.Calculation = xlCalculationManual
'
'
'
'  totalRow = Range("totalRow").Row
'
'  Set R = Range("B24:B" & totalRow - 1)
'
'  Set wR = Application.Intersect(R, R.Worksheet.UsedRange)
'
'  For Each Row In wR.Rows
'    CurH = Row.RowHeight
'    NewH = CurH
'    For Each C In Row.Cells
'      If C.MergeCells And C.WrapText And C.Column = C.MergeArea.Column Then
'        Set Ar = C.MergeArea
'        HrAlg = C.HorizontalAlignment
'        Ar.MergeCells = False
'        Ar.HorizontalAlignment = xlCenterAcrossSelection
'        Ar.Rows.AutoFit
'        If NewH < Ar.RowHeight Then
'          NewH = Ar.RowHeight
'        End If
'        Ar.MergeCells = True
'        Ar.HorizontalAlignment = HrAlg
'      End If
'    Next
'    Row.RowHeight = NewH
'    Next
 
 
totalRow = Range("totalRow").Row
fl = False
 
For a = 28 To totalRow
 
 Cells(a, 10).Value = Cells(a, 10).Value
 Cells(a, 11).Value = CDbl(Cells(a, 11).Value)
 Cells(a, 13).Value = CDbl(Cells(a, 13).Value)
 Cells(a, 15).Value = CDbl(Cells(a, 15).Value)
 Cells(a, 16).Value = CDbl(Cells(a, 16).Value)
Next
 
 
 
count_pages = ActiveWorkbook.Sheets.HPageBreaks.Count + 1
 
If count_pages = 1 Then
  Exit Sub
End If
 
totalRow = Range("totalRow").Row
 
viewState = ActiveWindow.View
ActiveWindow.View = xlPageBreakPreview
iRow1 = FIRST_ROW
For Each hpb In ActiveSheet.HPageBreaks
    iPageNum = iPageNum + 1
    iRow2 = hpb.Location.Row - 1
    
    If iRow2 >= totalRow + 20 Then
    
    fl = True
    Exit For
    
    End If
    
    If iRow2 >= totalRow Then
    
    iRow2 = rowI
    
    End If
    
    
'    If iRow2 = R.Rows.Row - 1 Then
'        R.Rows.PageBreak = xlPageBreakNone
'    End If
    
    Rows(iRow2).Insert
    Rows(iRow2 + 1).PageBreak = xlPageBreakManual
    Cells(iRow2, ITOGO_COL) = "Èòîãî ïî ñòðàíèöå " & iPageNum & ":"
    'Cells(iRow2, "J") = "Èòîãî ïî ñòðàíèöå " & iPageNum & ":"
    Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL)).FormulaR1C1 = _
        "=SUBTOTAL(9,R[" & iRow1 - iRow2 & "]C:R[-1]C)"
    Rows(iRow2).Font.Bold = True
    Rows(iRow2).Font.Size = 6
    
    Range("I" & iRow2).Select
    With Selection
        .Font.Size = 6
        .HorizontalAlignment = xlRight
    End With
    
    Cells(iRow2, 12).Value = "X"
    Cells(iRow2, 14).Value = "X"
    
    iRow1 = iRow2 + 1
    
Next
 
If fl = False Then
 
'Cells(iRow2, 11).Value = "X"
Cells(iRow2, 12).Value = "X"
Cells(iRow2, 14).Value = "X"
 
iRow2 = totalRow + iPageNum
Rows(iRow2).Insert
Cells(iRow2, ITOGO_COL) = "Èòîãî ïî ñòðàíèöå " & iPageNum + 1 & ":"
With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
    .FormulaR1C1 = "=SUBTOTAL(9,R[" & iRow1 - iRow2 & "]C:R[-1]C)"
    .NumberFormat = "0.00"
End With
Range(iRow2 & ":" & iRow2 + 1).Font.Bold = True
Range(iRow2 & ":" & iRow2 + 1).Font.Size = 6
 
Range("I" & iRow2).Select
With Selection
    .Font.Size = 6
    .HorizontalAlignment = xlRight
End With
 
 
 
Cells(iRow2, 12).Value = "X"
Cells(iRow2, 14).Value = "X"
'Cells(iRow2, 14).Value = "X"
End If
 
' --> ïîäìåíà äàííûõ â ôóòåðå. Äîáàâëåíî À. Æàëóäêîâûì
ActiveSheet.PageSetup.RightFooter = "Ñòðàíèöà " & "&P" & " Òîâàðíàÿ íàêëàäíàÿ ¹ " & Cells(23, 6).Value & " îò " & Cells(23, 8).Value
' <-- Âñòàâêà ëîãèêè îáðàáîòêè ôóòåðà çàâåðøåíà
 
 
'zoom = ActiveSheet.PageSetup.zoom
'ActiveSheet.ResetAllPageBreaks
'ActiveSheet.PageSetup.zoom = zoom
 
'iRow2 = iRow2 + 1
'Cells(iRow2, ITOGO_COL) = "Âñåãî ïðèõîä:"
'With Range(Cells(iRow2, FIRST_COL), Cells(iRow2, LAST_COL))
'    .FormulaR1C1 = "=SUBTOTAL(9,R[" & FIRST_ROW - iRow2 & "]C:R[-1]C)"
'    .NumberFormat = "0.00"
'End With
 
ActiveWindow.View = viewState
 
'--------------------------------------------------------->
 
'------------------------------------------------------------<
  
 
 
 
'Âñåãî ïðèõîä:
End Sub
 
Sub del_pic()
    ActiveSheet.Shapes.Range(Array("Ðèñóíîê 1")).Select
    Selection.Delete
End Sub
 
Sub text_del()
    Cells(1, 1).Select
    Selection.Clear
End Sub
 
 
 
 
 
'Sub setHeader()
'Cells(1, 1).Value = "Óâåäîìëåíèå! Äåíåæíîå òðåáîâàíèå ïî îïëàòå íèæåóêàçàííûõ ïîñòàâëåííûõ òîâàðîâ óñòóïëåíî Ïîñòàâùèêîì ÏÀÎ  «Ïðîìñâÿçüáàíê» (ÎÃÐÍ 1027739019142) íà îñíîâàíèè Ãåíåðàëüíîãî äîãîâîðà îá îáùèõ óñëîâèÿõ ôàêòîðèíãîâîãî îáñëóæèâàíèÿ ïîñòàâîê âíóòðè Ðîññèè îò" + Chr(34) + "02" + Chr(34) + "ìàðòà 2010ã. ¹ 070-ÂÐ-47-10, â ñâÿçè ñ ýòèì îïëàòó òîâàðîâ íåîáõîäèìî îñóùåñòâëÿòü  èñêëþ÷èòåëüíî â ïîëüçó ßðîñëàâëüñêèé ô-ë ÏÀÎ" + Chr(34) + "Ïðîìñâÿçüáàíê" + Chr(34) + "ïî ñëåäóþùèì ðåêâèçèòàì: ÈÍÍ/ÊÏÏ 7744000912 / 760402001, êîð/ñ÷åò 30101810300000000760; ÁÈÊ 047888760, ñ÷åò ¹ 47402810532000846601"
'End Sub
Источник

Сергей спрашивает:

Как реализовать макрос, который бы по тексту расставлял разрыв страницы в определенных местах, например, перед словом «Отчет»?

Можно использовать следующий макрос:

Sub insBreakPage()
'Вставка разрывов страниц перед словом "Отчет"
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .MatchCase = True 'Учитываем регистр искомого слова
    .Text = "Отчет" 'ищем слово
    .Replacement.Text = "^m^&^p"  'производим замену
    .Execute Replace:=wdReplaceAll
End With
End Sub

Если вы не знаете, как подключить к документу и применить этот макрос, изучите следующие заметки с сайта:

Создание макроса из готового кода

Автоматическая запись макроса

Источник

Sub Макрос1()

        Dim rng As Range, fnd As Find

            ‘1. Отключение монитора.
    Application.ScreenUpdating = False

        ‘2. Вставка после разрывов страниц разрывов разделов. Сразу нельзя заменить
        ‘ разрывы страниц на разрывы разделов, т.к. нет спецсимвола для разрыва
        ‘ раздела с текущей страницы — у всех разрывов разделов один ansi-символ 12.

            ‘1) Создание объектов для поиска.
    Set rng = ActiveDocument.Range(0, 0)
    Set fnd = rng.Find

        ‘2) Настройка поиска.
    fnd.Text = «^m»
    fnd.MatchWildcards = False
    fnd.Wrap = wdFindStop

        ‘3) Вставка разрывов разделов.
    Do While fnd.Execute = True
        ‘ Вставка перед разрывом страницы знака абзаца, если его нет, т.к.
            ‘ это кажется правильнее, чем после текста сразу будет разрыв.
        If rng.Characters(1).Previous.Text <> Chr(13) Then
            rng.InsertBefore Text:=Chr(13)
            ‘ Знак абзаца будет добавлен в «rng», поэтому смещаем левый край вправо,
                ‘ чтобы разрыв раздела встал после знака абзаца.
            rng.MoveStart Unit:=wdCharacter, Count:=1
        End If
        ‘ Вставка перед разрывом страницы разрыва раздела. Разрыв вставляется
            ‘ именно перед разрывом страницы, а не после, как могло бы показаться.
        rng.InsertBreak Type:=wdSectionBreakContinuous
        ‘ После вставки разрыва раздела «rng» сделает коллапс в начало найденного разрыва страницы,
            ‘ поэтому нужно сместится вправо на один символ, чтобы выйти за пределы
            ‘ найденного разрыва страницы и приступить к поиску следующего разрыва страницы.
        rng.Move Unit:=wdCharacter, Count:=1
    Loop

        ‘3. Удаление разрывов страниц.
    ‘1) Удаление разрывов страниц в файлах формата «doc» (это «Word 2003»).
        ‘ В старой версии для разрыва страницы не создавался отдельный абзац.
    If ActiveDocument.SaveFormat = wdFormatDocument Then
        With ActiveDocument.Range.Find
            .Text = «^m»
            .Replacement.Text = «»
            .Execute Replace:=wdReplaceAll
        End With
    ‘2) Удаление разрывов страниц в файлах нового формата («Word 2007+»).
        ‘ В новых версиях разрыв страницы помещается в отдельный абзац. Если просто
            ‘ удалить разрыв страницы, то останется лишний знак абзаца. Поэтому нужно удалять не
            ‘ просто разрыв страницы, а разрыв страницы и знак абзаца.
        ‘ Применять такой поиск: .Text = «^m^p» к doc-формату нельзя, т.к.
            ‘ если после разрыва страницы есть пустой абзац, то пустой абзац будет удалён.
    Else
        With ActiveDocument.Range.Find
            .Text = «^m^p»
            .Replacement.Text = «»
            .Execute Replace:=wdReplaceAll
        End With
    End If

        ‘4. Включение монитора.
    Application.ScreenUpdating = True

        ‘5. Сообщение.
    MsgBox «Готово.», vbInformation

End Sub

[свернуть]

Источник

Понравилась статья? Поделить с друзьями:
  • Разрыв страницы в word что делает
  • Разрыв страницы в word 2007 что это
  • Разрушительный сбой excel automation error
  • Разрыв страницы в excel 2016
  • Разрешить только одну ячейку excel