Hello Валерий,
Wednesday, May 31, 2006, 8:19:26 AM, you wrote:
ВБ> Добрый день(вечер, ночь, утро), Эксперты, Знатоки и просто ЛЮБИТЕЛИ давать
советы!
ВБ> У меня возник такой вопрос: Есть ли в ВОРДе возможность пересахронить (одним
ВБ> или двумя кликами мышкой или еще чем) многостраничный документ таким образом,
ВБ> чтобы каждая страница сохранилась отдельно, как самостоятельный документ?
ВБ> с уважением
ВБ> Валерий
Уважаемый Валерий.
Какм вариант решения Вашего вопроса сохранения готового документа Ворд
"каждый лист в отдельном файле" предлагаю использовать макрос.
Данный макрос создан на 99 % самим Вордом (у меня на Office XP
работает. Проблема была только когда есть сквозная таблица на
несколько листов ).
* В строке "For i = 1 To n", n - необходимо указать количество листов в
докумете.
* Готовые файлы сохраняются в корнивике диска Д (при необходимости
можно поменять).
Sub Макрос3()
'
' Макрос3 Макрос
' Макрос записан 02.06.06 bogdiv
'
Dim strDocName As String
For i = 1 To 10
strDocName = i & ".doc"
Selection.WholeStory
Selection.Copy
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="2"
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ChangeFileOpenDirectory "D:\"
ActiveDocument.SaveAs FileName:=strDocName, FileFormat:=wdFormatDocument,
_
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword
_
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=
_
False
Selection.WholeStory
Selection.PasteAndFormat (wdPasteDefault)
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="2"
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Next
ActiveDocument.Save
End Sub
С уважением Сергей.