1

Тема: Как разбить файл на отдельные файлы по одной странице

Здравствуйте. Есть срочная необходимость разбить файл Word (состоящий из N-листов, например 10) на отдельные файлы, состоящие из 1 листа каждый. Подскажите пожалуйста, как решить такую "задачку"? Спасибо.

2

Re: Как разбить файл на отдельные файлы по одной странице

Посмотрите, пожалуйста, здесь:
http://wordexpert.ru/forum/viewtopic.php?id=2633
Мы как раз сейчас обсуждаем особенности программной работы со страницами.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

3

Re: Как разбить файл на отдельные файлы по одной странице

Спасибо, посмотрел Вашу ссылку, но не нашел ответа на свой вопрос. Может кто еще, что подскажет в решении данной задачки.....

4

Re: Как разбить файл на отдельные файлы по одной странице

Алгоритм макроса может быть такой: Вы выделяете первую страницу, копируете ее, открываете новый документ, вставляете страницу в новый документ, сохраняете его под соответствующим именем и так далее со всеми страницами.
Напишете сами такой макрос?

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

5

Re: Как разбить файл на отдельные файлы по одной странице

К сожалению не напишу сам. "Не дружу" я с макросами. Если поможете написать, буду очень благодарен Вам. Быть может еще кому из форумчан пригодится данный "кейс"

6

Re: Как разбить файл на отдельные файлы по одной странице

POLYARikSPb пишет:

К сожалению не напишу сам. "Не дружу" я с макросами. Если поможете написать, буду очень благодарен Вам. Быть может еще кому из форумчан пригодится данный "кейс"

Попробую, если меня не обгонят другие эксперты. smile
Сейчас много работы.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

7

Re: Как разбить файл на отдельные файлы по одной странице

ОК, буду с нетерпением ждать

8

Re: Как разбить файл на отдельные файлы по одной странице

Выложите, пожалуйста, пример файла, к которому нужно применить такой макрос.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

9

Re: Как разбить файл на отдельные файлы по одной странице

Вот, пожалуйста

Post's attachments

Бланк уставок ШЭ2607 081_205 Л-111.doc 1005 Кб, 8 скачиваний с 2015-05-19 

You don't have the permssions to download the attachments of this post.

10

Re: Как разбить файл на отдельные файлы по одной странице

Получилось что-то такое:

Sub FormSomeFilesPages2()
    Dim i As Integer
    Dim j As Integer ' Номер страницы
    Dim strNameDoc As String ' Имя очередного сохраняемого документа
    j = 1
    ' Обход всех страниц главного документа
    For i = 1 To ActiveDocument.ActiveWindow.Panes(1).Pages.Count
        ' Переход на первую страницу
        Selection.HomeKey Unit:=wdStory
        ' Выделение текущей страницы
        ActiveDocument.Bookmarks("\page").Range.Select
        ' Вырезание выделенного фрагмента и помещение его в буфер обмена
        Selection.Cut
        ' Открыть новый документ
        Documents.Add DocumentType:=wdNewBlankDocument
        ' Вставить данные из буфера обмена в новый документ
        Selection.Paste
        ' Сохранить и закрыть новый документ
        strNameDoc = "doc" + str(j) + ".docx"
        ActiveDocument.SaveAs2 filename:=strNameDoc
        ActiveDocument.Close SaveChanges:=True
        j = j + 1
    Next i
End Sub

В процессе работы макроса оригинальный файл изменяется. Поэтому сохранять его после окончания макроса не надо.

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

11

Re: Как разбить файл на отдельные файлы по одной странице

При разделении Вашего файла у меня получилось на одну страницу меньше (см. приложение).
Чтобы получилось точнее Вам нужно сделать следующее:
1) Убрать повторение заголовков таблиц. Повторение заголовков как часть следующей страницы все равно не распознается (фактически его на этой странице нет).
2) Для всех таблиц нужно установить режим Не разрешать перенос строк на следующую страницу (Свойства таблицы - вкладка Строка - снять флажок Разрешить перенос строк на следующую страницу).

Post's attachments

doc.zip 508.46 Кб, 7 скачиваний с 2015-05-19 

You don't have the permssions to download the attachments of this post.
Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

12

Re: Как разбить файл на отдельные файлы по одной странице

Спасибо, вроде работает

13

Re: Как разбить файл на отдельные файлы по одной странице

Если после разбиения на одностраничные файлы отсутствует необходимость дальнейшего редактирования полученных одностраничных файлов, то самый надежный способ - это сохранить файл в формате PDF с последующим разбиением полученного PDF файла на отдельные страницы.
Во вложении результат такого разбиения, сделанного с помощью Foxit Phantom. Можно использовать и другие программы для редактирования PDF файлов.

Post's attachments

PDF_split.7z 415.23 Кб, 3 скачиваний с 2015-05-20 

You don't have the permssions to download the attachments of this post.

14

Re: Как разбить файл на отдельные файлы по одной странице

Спасибо за овет. Этот способ я и сам знаю. Задача состоит именно в разбивке на листы ворд. В дальнейшем, которые нужно вставлять в автокад по-странично, так как при вставке файла ворд (состоящего из N-листов) вставляется только первый лист ворда.... Вставлять в автокад в пдф формате мне не нужно......

Boris_R пишет:

Если после разбиения на одностраничные файлы отсутствует необходимость дальнейшего редактирования полученных одностраничных файлов, то самый надежный способ - это сохранить файл в формате PDF с последующим разбиением полученного PDF файла на отдельные страницы.
Во вложении результат такого разбиения, сделанного с помощью Foxit Phantom. Можно использовать и другие программы для редактирования PDF файлов.

15

Re: Как разбить файл на отдельные файлы по одной странице

Приветствую!
Помогите, пожалуйста, решить пару проблем...
1) При работе найденного на просторах инета макроса после разбиения word-документа на отдельные документы в них добавляется вторая пустая страница?
Что в макросе подкрутить, чтобы пустая страница не добавлялась?  roll

Sub SplitIntoPages() 
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 'Makes the code run faster and reduces screen _
flicker a bit. 
Set docMultiple = ActiveDocument 'Work on the active document _
(the one currently containing the Selection) 
Set rngPage = docMultiple.Range 'instantiate the range object
iCurrentPage = 1 
'get the document's page count
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages) 
Do Until iCurrentPage > iPageCount 
If iCurrentPage = iPageCount Then 
rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page) 
Else
'Find the beginning of the next page
'Must use the Selection object. The Range.Goto method will not work on a page
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1 
'Set the end of the range to the point between the pages
rngPage.End = Selection.Start 
End If 
rngPage.Copy 'copy the page into the Windows clipboard
Set docSingle = Documents.Add 'create a new document
docSingle.Range.Paste 'paste the clipboard contents to the new document
'remove any manual page break to prevent a second blank
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:="" 
'build a new sequentially-numbered file name based on the original multi-paged file name and path
strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc") 
docSingle.SaveAs strNewFileName 'save the new single-paged document
iCurrentPage = iCurrentPage + 1 'move to the next page
docSingle.Close 'close the new document
rngPage.Collapse wdCollapseEnd 'go to the next page
Loop 'go to the top of the do loop
Application.ScreenUpdating = True 'restore the screen updating 
'Destroy the objects.
Set docMultiple = Nothing 
Set docSingle = Nothing 
Set rngPage = Nothing 
End Sub

---------------
2. Ещё вопрос...
Планируется сделать паспорта ПК. Очень много.
Инфа из экселя сливается в word-форму через поля слияния (получается длинная простыня на много страниц), а вышеприведённым макросом разрезается на файлы и сохраняется. НО появились неудобство...
Документов после разбиения будет за 350 штук. Вышеприведённый макрос сохраняет нарезанные документы по шаблону "Название_исходного_файла+Номер". Придётся каждый файл открывать, копировать и/н ПК, закрывать, переименовывать файл  hmm ... Есть большое желание, чтобы макрос перед сохранением "заглядывал в определённое место в сохраняемом документе, брал с оттуда текст и присваивал этот текст как имя сохраняемого документа (инвентарный номер ПК)...
Подскажите, как это сделать?

Спасибо!

16

Re: Как разбить файл на отдельные файлы по одной странице

azur пишет:

Приветствую!
Помогите, пожалуйста, решить пару проблем...
1) При работе найденного на просторах инета макроса после разбиения word-документа на отдельные документы в них добавляется вторая пустая страница?
Что в макросе подкрутить, чтобы пустая страница не добавлялась?  roll

Sub SplitIntoPages() 
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 'Makes the code run faster and reduces screen _
flicker a bit. 
Set docMultiple = ActiveDocument 'Work on the active document _
(the one currently containing the Selection) 
Set rngPage = docMultiple.Range 'instantiate the range object
iCurrentPage = 1 
'get the document's page count
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages) 
Do Until iCurrentPage > iPageCount 
If iCurrentPage = iPageCount Then 
rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page) 
Else
'Find the beginning of the next page
'Must use the Selection object. The Range.Goto method will not work on a page
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1 
'Set the end of the range to the point between the pages
rngPage.End = Selection.Start 
End If 
rngPage.Copy 'copy the page into the Windows clipboard
Set docSingle = Documents.Add 'create a new document
docSingle.Range.Paste 'paste the clipboard contents to the new document
'remove any manual page break to prevent a second blank
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:="" 
'build a new sequentially-numbered file name based on the original multi-paged file name and path
strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc") 
docSingle.SaveAs strNewFileName 'save the new single-paged document
iCurrentPage = iCurrentPage + 1 'move to the next page
docSingle.Close 'close the new document
rngPage.Collapse wdCollapseEnd 'go to the next page
Loop 'go to the top of the do loop
Application.ScreenUpdating = True 'restore the screen updating 
'Destroy the objects.
Set docMultiple = Nothing 
Set docSingle = Nothing 
Set rngPage = Nothing 
End Sub

---------------
2. Ещё вопрос...
Планируется сделать паспорта ПК. Очень много.
Инфа из экселя сливается в word-форму через поля слияния (получается длинная простыня на много страниц), а вышеприведённым макросом разрезается на файлы и сохраняется. НО появились неудобство...
Документов после разбиения будет за 350 штук. Вышеприведённый макрос сохраняет нарезанные документы по шаблону "Название_исходного_файла+Номер". Придётся каждый файл открывать, копировать и/н ПК, закрывать, переименовывать файл  hmm ... Есть большое желание, чтобы макрос перед сохранением "заглядывал в определённое место в сохраняемом документе, брал с оттуда текст и присваивал этот текст как имя сохраняемого документа (инвентарный номер ПК)...
Подскажите, как это сделать?

Спасибо!

Ну так, документ в студию. Вторая пустая скорее всего добавляется из-за знака абзаца в конце. Просто добавьте в макрос строку удаления последнего знака абзаца. Что-то вроде
If ActiveDocument.Characters.Last = Chr(13) Then ActiveDocument.Characters.Last.Delete

А по поводу "заглядывать в конкретное место - надо знать место. Это может быть ячейка таблицы или по маркеру искать (вроде Selection.find по знаку "№").

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

17

Re: Как разбить файл на отдельные файлы по одной странице

Спасибо!

Fck_This пишет:

Что-то вроде
If ActiveDocument.Characters.Last = Chr(13) Then ActiveDocument.Characters.Last.Delete

- в какую строку добавить этот код?
--------

Fck_This пишет:

А по поводу "заглядывать в конкретное место - надо знать место. Это может быть ячейка таблицы или по маркеру искать (вроде Selection.find по знаку "№").

- приложил файл с первыми тремя листами результата слияния. Красным выделено место инвентарного номера.

Мысль пришла...
Изменить или добавить в другое место инвентарный номер нельзя (утверждённый бланка). "Это может быть ячейка таблицы" - если вдруг изменится таблица/бланк, то тогда макрос перестанет работать.
Быть может, добавить дополнительно мелким шрифтом и белого цвета поле слияния с и/н в верхний колонтитул (он свободен)?...
Так при изменении тела документа не затронется место, на которое будет "смотреть" макрос.

Post's attachments

000_!!!! - копия.docx 123.88 Кб, 2 скачиваний с 2018-09-10 

You don't have the permssions to download the attachments of this post.

18

Re: Как разбить файл на отдельные файлы по одной странице

Добавлять в самый конец (перед End Sub, разумеется), чтобы убрать последний знак абзаца в конце процедуры.
Ничего не надо выдумывать. Можно поиск произвести по маске

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

19

Re: Как разбить файл на отдельные файлы по одной странице

Fck_This пишет:

Добавлять в самый конец (перед End Sub, разумеется), чтобы убрать последний знак абзаца в конце процедуры.
Ничего не надо выдумывать. Можно поиск произвести по маске

Добавлять в самый конец (перед End Sub, разумеется), чтобы убрать последний знак абзаца в конце процедуры.
Ничего не надо выдумывать. Можно поиск произвести по маске "СИСТЕМНЫЙ БЛОК:
и/н: " с помощью процедуры Selection.Find и расширять область выделения Selection.Expand до параграфа, наш номер будет равен

Номер = Replace(selection.range.text, "СИСТЕМНЫЙ БЛОК:
и/н: ", "")

А потом сохраняем документ с нужным именем + переменная "Номер"

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871