Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Microsoft Office Новый топик    Ответить
 VBA.Word. Постраничное сохранение в отдельный файл.  [new]
sergant138
Member

Откуда:
Сообщений: 37
Добрый день! Мне нужно сохранить каждую страницу файла 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
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, ".rtf", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
FileName = Date
docSingle.SaveAs "C:\Windows\Temp\" & FileName & "." & iCurrentPage & ".rtf"
iCurrentPage = iCurrentPage + 1
docSingle.Close
rngPage.Collapse wdCollapseEnd
Loop
Application.ScreenUpdating = True
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub
28 авг 17, 16:58    [20754305]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
Cursky
Member

Откуда:
Сообщений: 153
sergant138,
Попробуйте заменить
docSingle.Range.Paste
на
docSingle.Range.PasteAndFormat (wdPasteDefault)
28 авг 17, 18:52    [20754583]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
sergant138
Member

Откуда:
Сообщений: 37
Спасибо, попробовал, но все равно текст съезжает. Перепробовал все параметры PasteAndFormat. Более того если руками копировать и вставлять в тот же самый документ - тоже сбивается форматирование. Может документ такой. Формат rtf.
29 авг 17, 09:00    [20755228]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
Shocker.Pro
Member

Откуда: ->|<- :адуктО
Сообщений: 17510
Не удалось усилием мысли скачать ваш файл. Дайте уже образец.
Вероятно, проблема со стилями.
29 авг 17, 09:49    [20755342]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
sergant138
Member

Откуда:
Сообщений: 37
Shocker.Pro,
Прикрепил файл.

К сообщению приложен файл (Spisok.rtf - 121Kb) cкачать
29 авг 17, 18:41    [20757029]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
Shocker.Pro
Member

Откуда: ->|<- :адуктО
Сообщений: 17510
Я не заметил, чтобы при копировании сбивалось форматирование, все отформатировано как надо. Весть текст строго на месте, все оформление сохранилось.

Но объекты рисования (линии) - да сбились, не там и не все. Видимо из-за привязки к абзацам, которые в свою очередь находятся в текстовых блоках.

Мне помогло в вашем документе следующее - я перетащил якорь привязки каждой линии к самому первому абзацу (в верхний левый угол листа). Этот абзац (в отличие от почти всех остальных) не находится сам в текстовом блоке, поэтому привязки переносятся нормально.
29 авг 17, 19:13    [20757092]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
ПЕНСИОНЕРКА
Member

Откуда: Владимирская обл
Сообщений: 4078
sergant138
Shocker.Pro,
Прикрепил файл.

Приложенный файл (Spisok.rtf - 121Kb)


предпочитаю подобные бланки делать таблицами
29 авг 17, 20:27    [20757176]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
sergant138
Member

Откуда:
Сообщений: 37
Спасибо. Для автоматического решения данного вопроса сделал следующее. Одним макросом беру оригинальный файл, выделяю все и удаляю. Пустой файл сохраняю как шаблон. Далее снова вторым макросом оригинальный файл копируется постранично и вставляется в шаблон. При это все форматирование сохраняется, в том числе все линии - то что нужно.
30 авг 17, 09:43    [20757834]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
sergant138
Member

Откуда:
Сообщений: 37
Shocker.Pro,
А вот еще странная ситуация. Другой файл, практически такой же, но на нем макрос не отрабатывает. Вернее все проходит без ошибок, но файлы получаются пустыми. В чем тут может быть дело?

К сообщению приложен файл (02.06.zip - 27Kb) cкачать
5 сен 17, 14:40    [20772980]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
Shocker.Pro
Member

Откуда: ->|<- :адуктО
Сообщений: 17510
sergant138
практически такой же
Чем же он "такой же"? В новом файле текст расположен в надписях, а в старом - во фреймах (ну или как они там называются). Откройте два файла рядом, выделите контейнер с тектсом - увидите отличие даже в меню
5 сен 17, 15:01    [20773077]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
sergant138
Member

Откуда:
Сообщений: 37
Shocker.Pro,

Да, действительно это так, спасибо. А как же теперь править макрос, что теперь выделять и вставлять и какими методами. С такими случаями еще не сталкивался.
5 сен 17, 15:55    [20773335]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
Shocker.Pro
Member

Откуда: ->|<- :адуктО
Сообщений: 17510
Надо экспериментировать. Навскидку - сейчас привязка всех надписей к первому абзацу и он же - разрыв страницы. Возможно, ваш алгоритм не захватывает этот абзац при выделении и потому - не копирует. Надо попробовать, к примеру, взять на один символ раньше и т.п.
5 сен 17, 16:07    [20773383]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
Shocker.Pro
Member

Откуда: ->|<- :адуктО
Сообщений: 17510
Shocker.Pro
Надо экспериментировать. Навскидку - сейчас привязка всех надписей к первому абзацу и он же - разрыв страницы. Возможно, ваш алгоритм не захватывает этот абзац при выделении и потому - не копирует. Надо попробовать, к примеру, взять на один символ раньше и т.п.
может эта же причина не копировала линии в первом случае и решатся сразу обе проблемы
5 сен 17, 16:09    [20773388]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
sergant138
Member

Откуда:
Сообщений: 37
Shocker.Pro,
Понял как выделять . Изменил код. Копирует нормально, но все-таки проблемы есть. То скопируется только первая страница, то все кроме последней.

       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
        iCurrentPage = 1
        iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
        Do Until iCurrentPage > iPageCount
        Dim MyRange As Range
Set MyRange = ActiveDocument.Range(0, 0)
Set MyRange = MyRange.GoTo(What:=wdGoToPage, Name:=iCurrentPage)
Set MyRange = MyRange.GoTo(What:=wdGoToBookmark, Name:="\page")
   MyRange.ShapeRange.Select
        Selection.Copy
        iTempDir = Environ("Temp")
        Set docSingle = Documents.Add
        docSingle.Range.Paste
        docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
        strNewFileName = Replace(docMultiple.FullName, ".rtf", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
        FileName = Date
        docSingle.SaveAs iTempDir & "\" & FileName & "." & iCurrentPage & "_Bank.rtf"
        iCurrentPage = iCurrentPage + 1
        docSingle.Close
        Loop
        Application.ScreenUpdating = True
        Set docMultiple = Nothing
        Set docSingle = Nothing
        Set rngPage = Nothing
        End Sub
6 сен 17, 11:51    [20775034]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
Shocker.Pro
Member

Откуда: ->|<- :адуктО
Сообщений: 17510
sergant138
То скопируется только первая страница, то все кроме последней.
это на одном файле по-разному срабатывает или на разных?
6 сен 17, 12:05    [20775128]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
sergant138
Member

Откуда:
Сообщений: 37
Shocker.Pro,
На одном . Но в основном не создается только последняя страница. То есть не выделяется. Все остальные в норме.

Вот окончательный, но до конца не работающий код.
Sub SplitIntoPages()
Application.ScreenUpdating = False
Set docMultiple = ActiveDocument
iCurrentPage = 1
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
Dim MyRange As Range
Set MyRange = ActiveDocument.Range(0, 0)
Set MyRange = MyRange.GoTo(What:=wdGoToPage, Which:=wdGoToNext, Name:=iCurrentPage)
Set MyRange = MyRange.GoTo(What:=wdGoToBookmark, Name:="\page")
MyRange.ShapeRange.Select
Selection.Copy
iTempDir = Environ("Temp")
Set docSingle = Documents.Add
docSingle.Range.Paste
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
strNewFileName = Replace(docMultiple.FullName, ".rtf", "_" & Right$("000" & iCurrentPage, 4) & ".doc")
FileName = Date
docSingle.SaveAs iTempDir & "\" & FileName & "." & iCurrentPage & "_Bank.rtf"
iCurrentPage = iCurrentPage + 1
docSingle.Close
Loop
Application.ScreenUpdating = True
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub

Модератор: Учимся использовать тэги оформления кода - FAQ
6 сен 17, 15:48    [20775989]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
Shocker.Pro
Member

Откуда: ->|<- :адуктО
Сообщений: 17510
Если с одним и тем же неизменным документом проблема, то она может быть связана с Active.

В вашем коде есть docMultiple, так его и надо использовать вместо ActiveDocument, либо вообще пользоваться ThisDocument
6 сен 17, 16:07    [20776055]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
sergant138
Member

Откуда:
Сообщений: 37
Shocker.Pro, Попробовал подставить ActiveDocument, но там все тоже самое.
Вот какой код получился:

Sub SplitIntoPages()
Application.ScreenUpdating = False
iCurrentPage = 1
iPageCount = ActiveDocument.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
Dim MyRange As Range
Set MyRange = ActiveDocument.Range(0, 0)
Set MyRange = MyRange.GoTo(What:=wdGoToPage, Which:=wdGoToNext, Name:=iCurrentPage)
Set MyRange = MyRange.GoTo(What:=wdGoToBookmark, Name:="\page")
MyRange.ShapeRange.Select
Selection.Copy
iTempDir = Environ("Temp")
Set docSingle = Documents.Add
docSingle.Range.Paste
FileName = Date
docSingle.SaveAs iTempDir & "\" & FileName & "." & iCurrentPage & "_Bank.rtf"
iCurrentPage = iCurrentPage + 1
docSingle.Close
Loop
Application.ScreenUpdating = True
Set docSingle = Nothing
Set rngPage = Nothing
End Sub


Также прикрепляю образец файла, там же макрос. Может что-то в моем компьютере.

К сообщению приложен файл (Primer.zip - 36Kb) cкачать
7 сен 17, 09:30    [20777335]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
Shocker.Pro
Member

Откуда: ->|<- :адуктО
Сообщений: 17510
Shocker.Pro
использовать вместо ActiveDocument
sergant138
Попробовал подставить ActiveDocument
7 сен 17, 09:40    [20777370]     Ответить | Цитировать Сообщить модератору
 Re: VBA.Word. Постраничное сохранение в отдельный файл.  [new]
Shocker.Pro
Member

Откуда: ->|<- :адуктО
Сообщений: 17510
По всей видимости, эта строка
Set MyRange = MyRange.GoTo(What:=wdGoToBookmark, Name:="\page")
не может выполниться для последней страницы - просто некуда идти. Пожалуй, для последней страницы (iCurrentPage = iPageCount) нужно сделать отдельный If и выделять Range до конца документа
7 сен 17, 10:49    [20777691]     Ответить | Цитировать Сообщить модератору
Все форумы / Microsoft Office Ответить