Страница 2 из 2
Re: Создание кнопки со своим VBA кодом
Добавлено: 21 фев 2010, 23:20
Busine2009
JuRMaN
Сделай следующее: Вид - Структура - Ctrl + А - На панели инструментов нажми "-" - перейди к последнему заголовку, посмотри, всё там свернулось или нет?
Ни разу не работал с сохранением, только завтра посмотрю. Ты же написал, что у тебя всё есть, я и не стал смотреть дальше.
Re: Создание кнопки со своим VBA кодом
Добавлено: 21 фев 2010, 23:34
JuRMaN
Да, там свернулось все. Кода у меня нет, только часть, и ту почерпнул из книги. Спасибо.
Re: Создание кнопки со своим VBA кодом
Добавлено: 21 фев 2010, 23:40
Busine2009
JuRMaN
тогда не знаю, в чём дело, у меня получилось, правда, у меня всего 2 заголовка.
Re: Создание кнопки со своим VBA кодом
Добавлено: 22 фев 2010, 10:09
Busine2009
JuRMaN
Код: Выделить всё
Sub HeadlinesCopyToTheDifferentFiles_2()
Dim vNumberOfHeadlines As Long
ActiveWindow.ActivePane.View.Type = wdMasterView
Selection.WholeStory
ActiveWindow.ActivePane.View.CollapseOutline Range:=Selection.Range
With ActiveDocument.Range.Find
.Style = ActiveDocument.Styles("Заголовок 1")
While .Execute
vNumberOfHeadlines = 1 + vNumberOfHeadlines
.Parent.Select
Selection.MoveLeft
Selection.EndKey Extend:=True
Selection.Copy
Documents.Add
Selection.Paste
Documents(1).SaveAs FileName:="E:\_Рабочий стол\Рабочая папка\" & vNumberOfHeadlines & "_Заголовок.doc"
Documents(1).Close
Wend
End With
End Sub
Re: Создание кнопки со своим VBA кодом
Добавлено: 22 фев 2010, 10:41
Busine2009
JuRMaN
Вот этот вариант подойдёт, если у тебя бардак в документе и стилем Заголовок 1 оформлено что нужно и что не нужно.
Но сначала тебе надо вставить перед каждым "Заголовком 1" разрыв раздела. Этот вариант плох тем, что в разные документы будут попадать части одного раздела, если, например, имеют разную ориентацию или размер.
Код: Выделить всё
Sub HeadlinesCopyToTheDifferentFiles_3()
Dim oSection As Section
Dim vNumberOfHeadlines As Long
For Each oSection In ActiveDocument.Sections
vNumberOfHeadlines = 1 + vNumberOfHeadlines
oSection.Range.Copy
Documents.Add
Selection.Paste
Documents(1).SaveAs FileName:="E:\_Рабочий стол\Рабочая папка\" & vNumberOfHeadlines & "_Заголовок.doc"
Documents(1).Close
Next
End Sub
Re: Создание кнопки со своим VBA кодом
Добавлено: 22 фев 2010, 20:05
Busine2009
JuRMaN
Вот ещё вариант, но он будет полезен, если в документе используются
только Заголовки 1 уровня:
Код: Выделить всё
Sub CopyPartsOfDocumentToTheDocuments()
Dim vNumberOfHeadlines As Long
On Error GoTo metka_1
With ActiveDocument.Range.Find
.Style = "Заголовок 1"
While .Execute
.Parent.Select
Selection.ExtendMode = True
Selection.GoTo what:=wdGoToHeading, which:=wdGoToNext
Selection.Copy
vNumberOfHeadlines = 1 + vNumberOfHeadlines
Documents.Add
Selection.Paste
Documents(1).SaveAs FileName:="E:\_Рабочий стол\Рабочая папка\" & vNumberOfHeadlines & "_Заголовок.doc"
Documents(1).Close
GoTo metka_2
metka_1:
vNumberOfHeadlines = 1 + vNumberOfHeadlines
.Parent.Select
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Copy
Documents.Add
Selection.Paste
Documents(1).SaveAs FileName:="E:\_Рабочий стол\Рабочая папка\" & vNumberOfHeadlines & "_Заголовок.doc"
Documents(1).Close
metka_2:
Wend
End With
End Sub
[ATTACH]1220[/ATTACH]
Ты можешь просматривать, что делает какая команда, открыв одновременно и документ Word и VBA и нажимать на кнопку, которая на рисунке.
Re: Создание кнопки со своим VBA кодом
Добавлено: 23 фев 2010, 01:00
JuRMaN
Busine2009
Спасибо огромное, сейчас буду все пробовать.
Вот что получилось, если необходимо добавить другие типы Заголовков (добавил Заголовок 2):
[html]
Sub CopyPartsOfDocumentToTheDocuments()
Dim vNumberOfHeadlines As Long
On Error GoTo metka_1
With ActiveDocument.Range.Find
.Style = "Заголовок 1"
While .Execute
.Parent.Select
Selection.ExtendMode = True
Selection.GoTo what:=wdGoToHeading, which:=wdGoToNext
Selection.Copy
vNumberOfHeadlines = 1 + vNumberOfHeadlines
Documents.Add
Selection.Paste
Documents(1).SaveAs FileName:="C:\путь\1" & vNumberOfHeadlines & "_Заголовок.doc"
Documents(1).Close
GoTo metka_2
metka_1:
vNumberOfHeadlines = 1 + vNumberOfHeadlines
.Parent.Select
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Copy
Documents.Add
Selection.Paste
Documents(1).SaveAs FileName:="C:\путь\1" & vNumberOfHeadlines & "_Заголовок.doc"
Documents(1).Close
metka_2:
Wend
End With
Dim vNumberOfHeadlines2 As Long
On Error GoTo metka_3
With ActiveDocument.Range.Find
.Style = "Заголовок 2"
While .Execute
.Parent.Select
Selection.ExtendMode = True
Selection.GoTo what:=wdGoToHeading, which:=wdGoToNext
Selection.Copy
vNumberOfHeadlines2 = 1 + vNumberOfHeadlines2
Documents.Add
Selection.Paste
Documents(1).SaveAs FileName:="C:\путь\2" & vNumberOfHeadlines2 & "_Заголовок.doc"
Documents(1).Close
GoTo metka_4
metka_3:
vNumberOfHeadlines2 = 1 + vNumberOfHeadlines2
.Parent.Select
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Copy
Documents.Add
Selection.Paste
Documents(1).SaveAs FileName:="C:\путь\2" & vNumberOfHeadlines2 & "_Заголовок.doc"
Documents(1).Close
metka_4:
Wend
End With
End Sub
[/html]