Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Разделение страниц на новые файлы - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Разделение страниц на новые файлы (Макросы/Sub)
Разделение страниц на новые файлы
Blacit Дата: Вторник, 10.12.2019, 09:27 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день, пожалуйста, не злитесь, новичок в этом деле.
Задача: файл с расширением .rtf и количеством внутренних страниц около 300+ разделить на новые файлы, чтобы для каждой страницы создался новый файл с расширением .rtf и название файла соответствовало строке ИД, например, в приложенном файле на первой странице ИД 5434566, значит название файла 5434566. Проблема также в том, что файл, данные в котором нужно разделять, находится с другими .rtf, нужные отличаются нумерацией в скобках, например, 70201420000620000017_05011012_31012015(0001)
Все остальные файлы, у которых нет скобок и цифр в них - не нужны.

ОСТАВШИЙСЯ ВОПРОС: как найти строку ИД и присвоить каждому файлу ИД на его странице.

Вот так выглядит строка, откуда нужно выдернуть ИД для названия файла.
Госпошлина за рассмотрение дела в суде в отношении Иван иванов Иванович (кредитный договор V_LN_423420_25423), (ИД 5434566), НДС нет.

Может, можете помочь реализовать задачу. Буду сильно благодарен.

Код, который написал

[vba]
Код
Option Explicit

Option Explicit

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 'Делает код работать быстрее и уменьшает мерцание экрана немного.
Set docMultiple = ActiveDocument 'Работа с активным документом(тот, который в настоящее время содержит выделение)
Set rngPage = docMultiple.Range 'Создать экземпляр объекта range
iCurrentPage = 1
'Получить количество страниц документа
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
If iCurrentPage = iPageCount Then
rngPage.End = ActiveDocument.Range.End 'Последняя страница (следующей страницы не будет)
Else
'Найдите начало следующей страницы
'Необходимо использовать объект выбора. Range. Метод goto не будет работать на странице
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
'Установите конец диапазона в точку между страницами
rngPage.End = Selection.Start
End If
rngPage.Copy 'Копировать страницу в буфер обмена Windows
Set docSingle = Documents.Add 'создание нового документа
docSingle.Range.Paste 'вставьте содержимое буфера обмена в новый документ
'Eдалите любой разрыв страницы вручную, чтобы предотвратить второй пробел
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
'Создайте новое последовательно пронумерованное имя файла на основе исходного многостраничного имени файла и пути к нему
strNewFileName = Replace(docMultiple.FullName, ".rtf", "_" & Right$("000" & iCurrentPage, 4) & ".rtf")
docSingle.SaveAs strNewFileName 'Сохраните новый одностраничный документ
iCurrentPage = iCurrentPage + 1 'Перейти на следующую страницу
docSingle.Close 'Закройте новый документ
rngPage.Collapse wdCollapseEnd 'Перейти на следующую страницу
Loop 'Перейти к началу цикла do
Application.ScreenUpdating = True 'Восстановление обновления экрана
'Уничтожьте объекты.
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub
[/vba]


Сообщение отредактировал Blacit - Вторник, 10.12.2019, 11:45
 
Ответить
СообщениеДобрый день, пожалуйста, не злитесь, новичок в этом деле.
Задача: файл с расширением .rtf и количеством внутренних страниц около 300+ разделить на новые файлы, чтобы для каждой страницы создался новый файл с расширением .rtf и название файла соответствовало строке ИД, например, в приложенном файле на первой странице ИД 5434566, значит название файла 5434566. Проблема также в том, что файл, данные в котором нужно разделять, находится с другими .rtf, нужные отличаются нумерацией в скобках, например, 70201420000620000017_05011012_31012015(0001)
Все остальные файлы, у которых нет скобок и цифр в них - не нужны.

ОСТАВШИЙСЯ ВОПРОС: как найти строку ИД и присвоить каждому файлу ИД на его странице.

Вот так выглядит строка, откуда нужно выдернуть ИД для названия файла.
Госпошлина за рассмотрение дела в суде в отношении Иван иванов Иванович (кредитный договор V_LN_423420_25423), (ИД 5434566), НДС нет.

Может, можете помочь реализовать задачу. Буду сильно благодарен.

Код, который написал

[vba]
Код
Option Explicit

Option Explicit

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 'Делает код работать быстрее и уменьшает мерцание экрана немного.
Set docMultiple = ActiveDocument 'Работа с активным документом(тот, который в настоящее время содержит выделение)
Set rngPage = docMultiple.Range 'Создать экземпляр объекта range
iCurrentPage = 1
'Получить количество страниц документа
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
If iCurrentPage = iPageCount Then
rngPage.End = ActiveDocument.Range.End 'Последняя страница (следующей страницы не будет)
Else
'Найдите начало следующей страницы
'Необходимо использовать объект выбора. Range. Метод goto не будет работать на странице
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
'Установите конец диапазона в точку между страницами
rngPage.End = Selection.Start
End If
rngPage.Copy 'Копировать страницу в буфер обмена Windows
Set docSingle = Documents.Add 'создание нового документа
docSingle.Range.Paste 'вставьте содержимое буфера обмена в новый документ
'Eдалите любой разрыв страницы вручную, чтобы предотвратить второй пробел
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
'Создайте новое последовательно пронумерованное имя файла на основе исходного многостраничного имени файла и пути к нему
strNewFileName = Replace(docMultiple.FullName, ".rtf", "_" & Right$("000" & iCurrentPage, 4) & ".rtf")
docSingle.SaveAs strNewFileName 'Сохраните новый одностраничный документ
iCurrentPage = iCurrentPage + 1 'Перейти на следующую страницу
docSingle.Close 'Закройте новый документ
rngPage.Collapse wdCollapseEnd 'Перейти на следующую страницу
Loop 'Перейти к началу цикла do
Application.ScreenUpdating = True 'Восстановление обновления экрана
'Уничтожьте объекты.
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub
[/vba]

Автор - Blacit
Дата добавления - 10.12.2019 в 09:27
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Разделение страниц на новые файлы (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2022 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!