 |
|
Разделение документа Word по 2 страницы
Приветствую!
Подскажите, нашел рабочий код разделения документа постранично, но нужно чтобы разделялось по две страницы. Т.е. есть, например, документ из 100 страниц, нужно создать несколько двухстраничных со страницами 1-2, 3-4, ... , 99-100
Что нужно изменить в следующем коде?
Скрытый текст
PHP код:
Sub Split()
Dim docMultiple As Document
Dim docSingle As Document
Dim rngPage As Range
Dim iCurrentPage As Integer
Dim iPageCount As Integer
Dim strNewFileName As String
Application.ScreenUpdating = False
Set docMultiple = ActiveDocument
Set rngPage = docMultiple.Range
iCurrentPage = 1
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
If iCurrentPage = iPageCount Then
rngPage.End = ActiveDocument.Range.End
Else
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
rngPage.End = Selection.Start
End If
rngPage.Copy
Set docSingle = Documents.Add
docSingle.Range.Paste
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
docSingle.SaveAs strNewFileName
iCurrentPage = iCurrentPage + 1
docSingle.Close
rngPage.Collapse wdCollapseEnd
Loop
Application.ScreenUpdating = True
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub
Пробовал менять значения рядом с iCurrentPage, но он то три страницы цеплял, то одну... К сожалению не сильно разбираюсь в VBA, извините... |
Не называйте собственные процедуры именами встроенных функций
Попробуйте так (не проверялось):
Скрытый текст
Код:
Option Explicit
Sub SplitBy2Pages()
Dim docMultiple As Document
'Dim docSingle As Document
Dim rngPage As Range
Dim iCurrentPage As Integer
Dim iPageCount As Integer
Dim strNewFileName As String
Application.ScreenUpdating = False
Set docMultiple = ActiveDocument
Set rngPage = docMultiple.Range
iCurrentPage = 1
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
If iCurrentPage = iPageCount Then
rngPage.End = ActiveDocument.Range.End
Else
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 2
rngPage.End = Selection.Start
End If
rngPage.Copy
With Documents.Add
.Range.Paste
'.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
.SaveAs strNewFileName
iCurrentPage = iCurrentPage + 2
.Close
End With
rngPage.Collapse wdCollapseEnd
Loop
Application.ScreenUpdating = True
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub
|
Время: 09:31.
© OSzone.net 2001-