Привет, уважаемые читатели. Если у вас есть большой документ, который вам нужно разделить, то давайте узнаем, существует ли какой-нибудь способ его поделить на отдельные файлы. Для этого мы воспользуемся возможностями Visual Basic Application для Word. Эта программа использует специальные код, которые диктуют Ворду, что нужно сделать. Итак, приступим.
Скрипт, который разделит файл в местах-маркерах
Прежде, чем запускать этот код, нужно подготовить документ к разделению на отдельные файлы.
В тех местах, где воровский файл будет разделен на несколько отдельных файлов, мы расставим маркеры в виде «///». Это скажет VBA, что в тех местах, где он встретит /// он поймет, что ему нужно будет дальнейшую часть сохранить в новый файл Word. Смотрите на скриншот, где я отметил маркером то место, где я хочу разбить документ.
Этот знак ставится в английской раскладке!
Новые файлы будут сохранены в папку с оригинальным документом, поэтому, советую тот документ, который вы будете разделять, сохраните в отдельную папку, как на скриншоте.
В конце документа разделяющий маркер ставить нет смысла, иначе VBA создаст просто пустой файл Word.
Шаг 1.
В окне Ворда нажмите на сочетание клавиш ALT + F11 для запуска Visual Basic Application.
Шаг 2.
В меню «Insert» — «Module». Теперь скопируйте код скрипта (его вы встретите ниже) и вставьте его в окне VBA.
Шаг 3.
Запустите выполнение кода, нажав F5 на клавиатуре, либо на панели на зеленый треугольник.
Этот VBA код разделит документ на отдельные файлы в тех местах, где были установлены маркеры. Выделите его левой кнопкой мыши и скопируйте (правой кнопкой мыши — Копировать).
Sub SplitNotes(delim As String, strFilename As String) Dim doc As Document Dim arrNotes Dim I As Long Dim X As Long Dim Response As Integer arrNotes = Split(ActiveDocument.Range, delim) Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections.Do you wish to proceed?", 4) If Response = 7 Then Exit Sub For I = LBound(arrNotes) To UBound(arrNotes) If Trim(arrNotes(I)) <> «» Then X = X + 1 Set doc = Documents.Add doc.Range = arrNotes(I) doc.SaveAs ThisDocument.Path & "" & strFilename & Format(X, "000") doc.Close True End If Next I End Sub Sub test() 'delimiter & filename SplitNotes "///", "Notes" End Sub
А вот результат разделения документа Ворд на отдельные файлы:
Скрипт, который разделит документ постранично
Порядок шагов, для запуска скрипта в Word тот же, что и в предыдущем способе. Скопируйте следующий ниже код и запустите его выполнение.
Этот код VBA разделит файл Word постранично, и каждую страницу сохранит в отдельные файлы. Выделите его левой кнопкой мыши и скопируйте (правой кнопкой мыши — Копировать).
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
Когда скрипт разделит документ на отдельные файлы, то все они будут сохранены в ту же папку, где находится оригинальный документ.
Подробнее о том, как работать с макросами в Excel в статье на сайте.
Немного юмора:
Большинство пользователей уверены, что если при загрузке Windоws водить курсором по кругу, то компьютер загрузится быстрее.
Спасибо. Очень пригодится. Только вот как расставлять маркеры — вообще не написано./// — это я набрала с клавиатуры. А в WORD как?Остальное вроде бы понятно, непонятен только список документов, или файлов, курсивом и бледный такой, это зачем? И еще — непонятно, зачем столько много документов хранить в одной папке, чтобы их разделять? А нельзя в разных папках? Или это на всякий случай? Еще не написано, какого года эта версия WORD.Спасибо.
Спасибо, Виктория, за ваши замечания. Если остались вопросы, то я дополню статью, сделаю более подробную инструкцию. Подписывайтесь, чтобы быть в курсе
Добрый день! При запуске макроса выходит ошибка. Можете подсказать в чем причина? Куда можно отправить скрин ошибки?
Добрый. Скрин можно выложить вот сюда fastpic.ru. Сообщение отправляйте через форму контактов http://v-ofice.ru/contacts/ и попробую вам помочь
Спасибо всем, кто сообщил, что в скрипт не работает. Закралась некоторая ошибка, скрипты обновил, должный работать.
Поправил скрипт немного, вышло так: Sub SplitNotes(delim As String, strFilename As String) Dim doc As Document Dim arrNotes Dim I As Long Dim X As Long Dim Response As Integer arrNotes = Split(ActiveDocument.Range, delim) If Response = 7 Then Exit Sub For I = LBound(arrNotes) To UBound(arrNotes) If Trim(arrNotes(I)) «» Then X = X + 1 Set doc = Documents.Add doc.Range = arrNotes(I) doc.SaveAs ThisDocument.Path & «/» & strFilename & Format(X, «000») doc.Close True End If Next I End Sub Sub test() ‘delimiter & filename SplitNotes «11223344», «Notes» End Sub
Очень нужная и полезная функция но к сожалению у меня код не выполняется (постраничное разбиение) MS Word 2013 Сначала придрался ко всем комментариям после ‘ — удалила Дальше выдает ошибку «424» — нет объекта. Подскажите пожалуйста как исправить, спасибо.
Разобрался в чем проблема — при выводе кода на сайт он немного изменялся, а потому и не работал. Сейчас работает.
Выдает синтаксическую ошибку в строке Sub test() delimiter & filename
Разобрался в чем проблема — при выводе кода на сайт он немного изменялся, а потому и не работал. Сейчас работает.
При попытке разделить документ на два файла система оповещает о такой вот ошибке: doc.SaveAs ThisDocument.Path & « \ » & strFilename & Format(X, «000») В конце не должно быть нулей… Как быть?
А каким способом пользовались? Судя по ошибке Ворд ругается на неправильно указанный путь.
пользовался способом, указанным автором выше (разделение файла на несколько частей). Вот эта строчка создает проблемы: doc.SaveAs ThisDocument.Path & « \ » & strFilename & Format(X, «000»)
Код подправил, попробуйте еще раз.
Замечательно. Огромное спасибо, спасли полчаса моей жизни сейчас и долгие часы в будущем!
Спасибо. Рад, что смог помочь
Благодарю! Выручили! Сэкономил вагон времени
Рад, что мои знания вам помогли ?
Каждый раз выскакивает окно сохранить как, а потом ошибка.. Приходится нажимать End и запускать заново, теряется всякий смысл. Можно ли сделать так, что сохранение шло полностью и без запросов
Отправляйте хотя бы скриншот или порядок ваших действий
Повторил тоже самое на работе — все сработало… а дома никак. Windows 8.1 Office 2003. Проблема в том, что создание файлов происходит не в фоновом режиме, а каждый раз возникает окно «сохранить как» и ждет моих действий.. возможно это какая-то настройка безопасности.. не подскажете как убрать это?
Попробуйте запустить Ворд от имени администратора, нажав по ярлыку программы правой кнопкой мышки.
Возможно ли сохранить форматирование текста (колонтитули, обекты, ссылки и т.д.) при раделении с помощью маркеров? Данные действия теряют смисл поскольку время потраченое на форматирование больше чем простое пересохранение и вибрасивание лишнего текста. Спасибо!
Те способы, что описаны выше — это все, что могу предложить вам. Как еще разделить документ на части я не знаю
Происходит потеря форматирования изначального документа.. Файлы на выходе получаются без всякого форматирования. Не знаете как с этим бороться?
Попробуйте форматирование вернуть вот таким способом: http://v-ofice.ru/word/skopirovat-stil-iz-odnovogo-v-drugoi-word/
Здравствуйте, а подскажите где в скрипте поменять, что бы он по две странице копировал в новый файл?
Добрый день. Я не специалист скриптов, но попробуйте поменять вот эти значения iCurrentPage = 2 Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 2
Добрый день) подскажите пожалуста, а как можно сделать так что бы при сохранении ворд брал для имени первую строчку полученного файла? понимаю что коряво написал но только-только узнал какая это мощная штука — макросы)
Добрый день, Дмитрий. Я не являюсь гуру макросов. Я умею находить решения и рассказать о них людям.
Спасибо Вам огромное!!!! Вы мне полжизни спасли. Был 1 файл и 759 страниц, стало 759 файлов и 1 страница.
Добрый день. Поле разбивки 1230 страничного файла Ворд на несколько файлов, исходные таблицы в Ворде преобразовались в построчное отображение каждого значения. Хотелось просто разбить громадный файл на ряд мелких для удобства работы. Это возможно?
Добрый. Все известные мне способы приведены в статье.
Спасибо, все сработало как надо!
Штука на самом деле очень полезная, НО… Этот скрипт нужно дорабатывать до ума. Он действительно делит документ на файлы, но при этом полностью его упрощает, а именно удаляет все таблицы, линии, контитулы и т.д.
Да, штука отличная, а у меня сплошь таблицы , есть ли еще способ? документ в 110 мб..
Гениально! Сработало, спасибо большое авторам!
в новых документах шрифт и размер изменен как это исправить.