Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Приветствую всех, кто хочет жить проще и лучше в вордовском мире. Прошу помощи. Необходимо скопировать структуру документа (появляется нажатием Схема документа) в новый файл, чтобы не шерстить весь текст, выделяя заголовки с нажатой клавишей Ctrl. Возможны другие способы проделать данную операцию, но сделав минимум телодвижений? Поделитесь знаниями. Спасибо.
Скопируй заголовки и структура появится сама собой
Скопируй заголовки и структура появится сама собой
В этом всё и дело, просматривать весь документ с зажатой клавишей Ctrl очень не серьёзно. Если не машина, так рука подведет и дрогнет. Нужно, чтобы не человек, а машина сама копировала все заголовки. Если копировать из оглавления, то получается, что хотел, но только текст вставлен в поле, а так не нужно. Другие способы есть?
После трудового дня как-то не думается. Вот решение в лоб:
Копирование всех абзацев. чей уровень отличен от основного текста
Sub CopyStructure()
Dim oPar As Paragraph
Dim oNewDoc As Document
Dim bCopied As Boolean
Set oPar = ActiveDocument.Paragraphs.First
Set oNewDoc = Documents.Add(Visible:=False)
'Перебор всех абзацев в тексте, отбирая те, которые не основной текст
Do Until oPar Is Nothing
If oPar.OutlineLevel <> wdOutlineLevelBodyText Then
bCopied = True
oNewDoc.Range.InsertAfter oPar.Range.Text
'Применяем к абзацу соответствующий стиль
If Not StyleExists(oNewDoc, oPar.Style) Then
'Если в новом документе стиля нет, то копируем
Application.OrganizerCopy ActiveDocument.FullName, oNewDoc.FullName, oPar.Style, wdOrganizerObjectStyles
End If
oNewDoc.Paragraphs.Last.Previous.Style = oPar.Style
End If
Set oPar = oPar.Next
DoEvents
Loop
If bCopied Then
Application.Visible = True
Else
oNewDoc.Close False
End If
End Sub
'Функция проверяет наличие стиля в документе
Function StyleExists(Doc As Document, StyleName As String) As Boolean
Dim sName As String
On Error Resume Next
sName = Doc.Styles(StyleName).NameLocal
StyleExists = Err.Number = 0
Err.Clear
End FunctionОчень надеюсь, что найдётся более красивое решение.
Вот другой метод. Здесь структура не копируется, а сохраняется вместе со всеми свойствами исходного документа. А уж как лучше решать Вам, это зависит от назначения полученного документа-структуры.
Sub ExcludeStructure()
Dim D As Document
Dim R As Range
Set D = Application.Documents.Add( _
Template:=ActiveDocument.FullName)
Set R = D.Range(0, 0)
With R.Find
.ParagraphFormat.OutlineLevel = wdOutlineLevelBodyText
.Format = True
.Forward = True
.Wrap = wdFindStop
End With
Do While R.Find.Execute
R.Expand wdParagraph
R.Delete
Loop
D.UndoClear
End SubВажно: обрабатываемый документ должен быть предварительно сохранен!!!
Благодарю всех за помощь, у меня все получилось... с макросами дело раньше не имел (кроме макроса "удалить лишние пробелы" и "заменить кавычки"), но в итоге они очень облегчают жизнь. Буду впредь обращать внимание на эту возможность быстро и качественно решить требуемую задачу.
Структура документа показывается в свойствах документа на вкладке Состав. Вот только как эти данные от туда вытащить?
viter.alex пишет:Скопируй заголовки и структура появится сама собой
В этом всё и дело, просматривать весь документ с зажатой клавишей Ctrl очень не серьёзно. Если не машина, так рука подведет и дрогнет. Нужно, чтобы не человек, а машина сама копировала все заголовки. Если копировать из оглавления, то получается, что хотел, но только текст вставлен в поле, а так не нужно. Другие способы есть?
Я бы сделал так:
1 - создать оглавление
2 - выделить его и скопировать (Ctrl-C)
3 - в другом документе вставить (Ctrl-V) в режиме "Только текст"
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться