VBA.Word. Постраничное сохранение в отдельный файл. / Microsoft Office

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / VBA.Word. Постраничное сохранение в отдельный файл.

20 сообщений из 20, страница 1 из 1

VBA.Word. Постраничное сохранение в отдельный файл.

#39511804

sergant138

Участник

Сообщения: 37

Рейтинг: 0 / 0

Добрый день! Мне нужно сохранить каждую страницу файла Word в отдельный файл. И вроде бы все работает, да только форматирование в сохраненных файлах сбивается. Можно ли что-то подправить в макросе, чтобы форматирование осталось?
Заранее спасибо.
Вот макрос.

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.

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

...

Рейтинг:

0 / 0

28.08.2017, 16:58

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39511856

Cursky

Участник

Сообщения: 164

Рейтинг: 0 / 0

sergant138,
Попробуйте заменить

Код: vbnet

docSingle.Range.Paste

на

Код: vbnet

docSingle.Range.PasteAndFormat (wdPasteDefault)

...

Рейтинг:

0 / 0

28.08.2017, 18:52

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39511992

sergant138

Участник

Сообщения: 37

Рейтинг: 0 / 0

Спасибо, попробовал, но все равно текст съезжает. Перепробовал все параметры PasteAndFormat. Более того если руками копировать и вставлять в тот же самый документ - тоже сбивается форматирование. Может документ такой. Формат rtf.

...

Рейтинг:

0 / 0

29.08.2017, 09:00

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39512019

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

Не удалось усилием мысли скачать ваш файл. Дайте уже образец.
Вероятно, проблема со стилями.

...

Рейтинг:

0 / 0

29.08.2017, 09:49

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39512417

sergant138

Участник

Сообщения: 37

Рейтинг: 0 / 0

Shocker.Pro,
Прикрепил файл.

...

Рейтинг:

0 / 0

29.08.2017, 18:41

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39512426

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

Я не заметил, чтобы при копировании сбивалось форматирование, все отформатировано как надо. Весть текст строго на месте, все оформление сохранилось.

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

Мне помогло в вашем документе следующее - я перетащил якорь привязки каждой линии к самому первому абзацу (в верхний левый угол листа). Этот абзац (в отличие от почти всех остальных) не находится сам в текстовом блоке, поэтому привязки переносятся нормально.

...

Рейтинг:

0 / 0

29.08.2017, 19:13

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39512440

ПЕНСИОНЕРКА

Участник

Откуда: Владимирская обл

Сообщения: 4 809

Рейтинг: 0 / 0

sergant138Shocker.Pro,
Прикрепил файл.

http://www.sql.ru/forum/actualfile.aspx?id=20757029] Приложенный файл (Spisok.rtf - 121Kb)

предпочитаю подобные бланки делать таблицами

...

Рейтинг:

0 / 0

29.08.2017, 20:27

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39512601

sergant138

Участник

Сообщения: 37

Рейтинг: 0 / 0

Спасибо. Для автоматического решения данного вопроса сделал следующее. Одним макросом беру оригинальный файл, выделяю все и удаляю. Пустой файл сохраняю как шаблон. Далее снова вторым макросом оригинальный файл копируется постранично и вставляется в шаблон. При это все форматирование сохраняется, в том числе все линии - то что нужно.

...

Рейтинг:

0 / 0

30.08.2017, 09:43

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39515732

sergant138

Участник

Сообщения: 37

Рейтинг: 0 / 0

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

...

Рейтинг:

0 / 0

05.09.2017, 14:40

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39515768

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

sergant138практически такой жеЧем же он "такой же"? В новом файле текст расположен в надписях, а в старом - во фреймах (ну или как они там называются). Откройте два файла рядом, выделите контейнер с тектсом - увидите отличие даже в меню

...

Рейтинг:

0 / 0

05.09.2017, 15:01

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39515831

sergant138

Участник

Сообщения: 37

Рейтинг: 0 / 0

Shocker.Pro,

Да, действительно это так, спасибо. А как же теперь править макрос, что теперь выделять и вставлять и какими методами. С такими случаями еще не сталкивался.

...

Рейтинг:

0 / 0

05.09.2017, 15:55

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39515845

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

Надо экспериментировать. Навскидку - сейчас привязка всех надписей к первому абзацу и он же - разрыв страницы. Возможно, ваш алгоритм не захватывает этот абзац при выделении и потому - не копирует. Надо попробовать, к примеру, взять на один символ раньше и т.п.

...

Рейтинг:

0 / 0

05.09.2017, 16:07

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39515848

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

Shocker.ProНадо экспериментировать. Навскидку - сейчас привязка всех надписей к первому абзацу и он же - разрыв страницы. Возможно, ваш алгоритм не захватывает этот абзац при выделении и потому - не копирует. Надо попробовать, к примеру, взять на один символ раньше и т.п.может эта же причина не копировала линии в первом случае и решатся сразу обе проблемы

...

Рейтинг:

0 / 0

05.09.2017, 16:09

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39516308

sergant138

Участник

Сообщения: 37

Рейтинг: 0 / 0

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

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.

       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

...

Рейтинг:

0 / 0

06.09.2017, 11:51

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39516340

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

sergant138То скопируется только первая страница, то все кроме последней.это на одном файле по-разному срабатывает или на разных?

...

Рейтинг:

0 / 0

06.09.2017, 12:05

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39516570

sergant138

Участник

Сообщения: 37

Рейтинг: 0 / 0

Shocker.Pro,
На одном . Но в основном не создается только последняя страница. То есть не выделяется. Все остальные в норме.

Вот окончательный, но до конца не работающий код.

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.

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

...

Рейтинг:

0 / 0

06.09.2017, 15:48

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39516583

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

Если с одним и тем же неизменным документом проблема, то она может быть связана с Active .

В вашем коде есть docMultiple, так его и надо использовать вместо ActiveDocument, либо вообще пользоваться ThisDocument

...

Рейтинг:

0 / 0

06.09.2017, 16:07

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39516969

sergant138

Участник

Сообщения: 37

Рейтинг: 0 / 0

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

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.

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

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

...

Рейтинг:

0 / 0

07.09.2017, 09:30

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39516982

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

Shocker.Proиспользовать вместо ActiveDocumentsergant138Попробовал подставить ActiveDocument

...

Рейтинг:

0 / 0

07.09.2017, 09:40

| Ответить | Цитировать | Написать

VBA.Word. Постраничное сохранение в отдельный файл.

#39517108

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

По всей видимости, эта строка

Код: vbnet

Set MyRange = MyRange.GoTo(What:=wdGoToBookmark, Name:="\page")

не может выполниться для последней страницы - просто некуда идти. Пожалуй, для последней страницы (iCurrentPage = iPageCount) нужно сделать отдельный If и выделять Range до конца документа

...

Рейтинг:

0 / 0

07.09.2017, 10:49

| Ответить | Цитировать | Написать

20 сообщений из 20, страница 1 из 1

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / VBA.Word. Постраничное сохранение в отдельный файл.

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=61&tid=2172579]:	0ms
get settings:	8ms
get forum list:	16ms
check forum access:	4ms
check topic access:	4ms
track hit:	66ms
get topic data:	9ms
get forum data:	2ms
get page messages:	58ms
get tp. blocked users:	1ms
others:	290ms

total:	458ms