1

Тема: Схема документа. Как скопировать?

Приветствую всех, кто хочет жить проще и лучше в вордовском мире. Прошу помощи. Необходимо скопировать структуру документа (появляется нажатием Схема документа) в новый файл, чтобы не шерстить весь текст, выделяя заголовки с нажатой клавишей Ctrl. Возможны другие способы проделать данную операцию, но сделав минимум телодвижений? Поделитесь знаниями. Спасибо.

2

Re: Схема документа. Как скопировать?

Скопируй заголовки и структура появится сама собой

Лучше день потерять — потом за пять минут долететь!

3

Re: Схема документа. Как скопировать?

viter.alex пишет:

Скопируй заголовки и структура появится сама собой

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

4

Re: Схема документа. Как скопировать?

После трудового дня как-то не думается. Вот решение в лоб:
Копирование всех абзацев. чей уровень отличен от основного текста

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

Очень надеюсь, что найдётся более красивое решение.

Лучше день потерять — потом за пять минут долететь!

5

Re: Схема документа. Как скопировать?

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

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

Важно: обрабатываемый документ должен быть предварительно сохранен!!!

Макросы под заказ и готовый пакет - mtdmacro.ru

6

Re: Схема документа. Как скопировать?

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

7

Re: Схема документа. Как скопировать?

Структура документа показывается в свойствах документа на вкладке Состав. Вот только как эти данные от туда вытащить?

8

Re: Схема документа. Как скопировать?

k.h.o.m.a.n. пишет:
viter.alex пишет:

Скопируй заголовки и структура появится сама собой

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

Я бы сделал так:
1 - создать оглавление
2 - выделить его и скопировать (Ctrl-C)
3 - в другом документе вставить (Ctrl-V) в режиме "Только текст"