1

Тема: Содержание в виде таблице по ГОСТ

Необходимо сделать содержание документа в виде таблицы в соответствии с ГОСТ.
Для этой цели пытаюсь написать макрос (шаблон с примером в прикрепленном файле).
В качестве названий разделов и подразделов используются стили "Заголовок 1", "Заголовок 2" и т.д. 
При написании возникла проблема - как узнать количество заголовков всех уровней в документе.
Пытался использовать значение ActiveDocument.CountNumberedItems(wdNumberParagraph).
Но сюда кроме заголовков попадают и нумерованные/ненумерованные списки и при выполнении макроса возникает ошибка.
Как узнать только количество заголовков???

Post's attachments

Содержание.dot 352.5 Кб, 30 скачиваний с 2010-08-23 

You don't have the permssions to download the attachments of this post.

2

Re: Содержание в виде таблице по ГОСТ

Давайте пойдём другим путём: сформируем содержание стандартными методами, а потом попробуем преобразовать его в таблицу. Попробуйте такой макрос:

Sub MyContent()
  Dim oRng As Range
  Dim oTbl As Table
  Dim oCell As Cell

  'Добавляем содержание в документ
  With ActiveDocument
    .TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _
      True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
      LowerHeadingLevel:=4, IncludePageNumbers:=True, AddedStyles:="", _
      UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseOutlineLevels:= _
      True
    .TablesOfContents(1).TabLeader = wdTabLeaderSpaces
    .TablesOfContents.Format = wdIndexIndent
    Set oRng = .TablesOfContents(.TablesOfContents.Count).Range
    'Разбиваем поле содержания
    oRng.Fields.Unlink
    'Преобразуем разбитое содержание в таблицу
    Set oTbl = oRng.ConvertToTable(vbTab)
  End With

  'Добавляем один столбец слева
  oTbl.Columns.Add oTbl.Columns(1)

  For Each oCell In oTbl.Columns(2).Cells
    Set oRng = ActiveDocument.Range(oCell.Range.Start, oCell.Range.End - 1)
    'Ссылка на номер
    oRng.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdNumberFullContext, ReferenceItem:=oCell.RowIndex, InsertAsHyperlink:=True
    oCell.Range.InsertAfter "." & Chr(160)
    'Ссылка на текст
    Set oRng = ActiveDocument.Range(oCell.Next.Range.Start, oCell.Next.Range.End - 1)
    oRng.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdContentText, ReferenceItem:=oCell.RowIndex, InsertAsHyperlink:=True
    'Ссылка на номер страницы
    Set oRng = ActiveDocument.Range(oCell.Next.Next.Range.Start, oCell.Next.Next.Range.End - 1)
    oRng.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdPageNumber, ReferenceItem:=oCell.RowIndex, InsertAsHyperlink:=True
    oCell.Merge oCell.Next
    'Удаляем абзаца, которые появляются после объединения ячеек
    oCell.Range.Find.Execute FindText:="^p", ReplaceWith:="", Replace:=wdReplaceAll
    DoEvents
  Next
  'Форматирование таблицы
  With oTbl
    .Rows.SetLeftIndent LeftIndent:=-21.6, RulerStyle:=wdAdjustNone
    .PreferredWidth = CentimetersToPoints(18.5)
    .AllowPageBreaks = True
    .AllowAutoFit = False
    'Устанваливаем отсутп от края (вровень с рамочкой) и размеры колонок
    .Columns(1).PreferredWidthType = wdPreferredWidthPoints
    .Columns(1).PreferredWidth = CentimetersToPoints(6)
    .Columns(2).PreferredWidthType = wdPreferredWidthPoints
    .Columns(2).PreferredWidth = CentimetersToPoints(9.5)
    .Columns(3).PreferredWidthType = wdPreferredWidthPoints
    .Columns(3).PreferredWidth = CentimetersToPoints(3)
    'заголовок таблицы
    .Cell(1, 1).Range.Text = "Обозначение"
    .Cell(1, 2).Range.Text = "Наименование"
    .Cell(1, 3).Range.Text = "Примечание"
    .Columns.Last.Select
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    With .Rows(1).Range
      .Font.Bold = True
      .Font.Size = 12
      .ParagraphFormat.Alignment = wdAlignParagraphCenter
    End With
  End With
End Sub
Лучше день потерять — потом за пять минут долететь!

3

Re: Содержание в виде таблице по ГОСТ

Спасибо за ваш ответ. О таком решении я бы не догадался. Но к сожалению оно  не совсем подходит. При большом количестве заголовков >60 время выполнения скрипта на моем компьютере 1-1,5 мин. Поэтому изменил немного 1 вариант. Добавил обработку ошибок. Время выполнения примерно 30-40 сек.

Sub Содержание()
'
Dim n, i As Integer
Dim strLen As Integer
Dim strCell As String


'Количество элементов
n = ActiveDocument.CountNumberedItems(wdNumberParagraph)
'Создаем и форматируем таблицу
Set oTable = ActiveDocument.Tables.Add(Selection.Range, 3, 3)        ' заголовок + 2 дополнительные строки
oTable.Rows.SetLeftIndent LeftIndent:=-21.5, RulerStyle:=wdAdjustNone
oTable.PreferredWidth = CentimetersToPoints(18.5)
oTable.AllowPageBreaks = True
oTable.AllowAutoFit = False

'Устанваливаем отсутп от края (вровень с рамкой) и размеры колонок
With oTable
    .Columns(1).PreferredWidthType = wdPreferredWidthPoints
    .Columns(1).PreferredWidth = CentimetersToPoints(6)
    .Columns(2).PreferredWidthType = wdPreferredWidthPoints
    .Columns(2).PreferredWidth = CentimetersToPoints(9.5)
    .Columns(3).PreferredWidthType = wdPreferredWidthPoints
    .Columns(3).PreferredWidth = CentimetersToPoints(3)
    'заголовок таблицы
    .Cell(1, 1).Range.Text = "Обозначение"
    .Cell(1, 2).Range.Text = "Наименование"
    .Cell(1, 3).Range.Text = "Примечание"
    .Rows(1).Select
End With
Selection.Font.Bold = wdToggle
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

'Заполняем таблицу
    On Error GoTo err1
     For i = 1 To n
        
        'во вторую колонку вносим номер заголовка
        oTable.Cell(i + 1, 2).Select
        Selection.MoveLeft
        Selection.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdNumberFullContext, ReferenceItem:=i, InsertAsHyperlink:=True
        Selection.TypeText Text:=". "
        ' и название
        Selection.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdContentText, ReferenceItem:=i, InsertAsHyperlink:=True
        ' ОПРЕДЕЛЯЕМ ДЛИНУ СТРОКИ ВО ВТОРОЙ ЯЧЕЙКЕ
        strCell = oTable.Cell(i + 1, 2).Range.Text
        strLen = Len(strCell)
        If strLen > 30 Then
            'MsgBox (strCell)
        End If
        
        'в третью колонку вносим номер страницы. Выравниваем по центру
        oTable.Cell(i + 1, 3).Select
        Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        Selection.MoveLeft
        Selection.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdPageNumber, ReferenceItem:=i, InsertAsHyperlink:=True
        
        'добавляем строку перед последней
        oTable.Rows.Add (oTable.Rows(oTable.Rows.Count))
     Next

err1: 'при возникновении ошибки удаляем 2 последние строки и завершаем скрипт
    oTable.Rows(oTable.Rows.Count).Delete
    oTable.Rows(oTable.Rows.Count).Delete
    Exit Sub

End Sub

Код конечно не совсем правильный, но рабочий.

Но это еще не все. Возникла следующая проблема. По ГОСТу требуется чтоб высота каждой строки  составляла 8 см. Длинные заголовки не влезают в одну строчку и надо переносить. Длину строки в см, насколько я знаю, макросами получить невозможно. Поэтому воспользовался средним значением количества символов (30 символов).
Как вырезать из ячейки только часть текста найти так и не смог  sad.
Каким образом возможно это реализовать.

Пока что остановился на варианте разбивка по строчкам вручную (благо в большинстве случаев содержание не меняется) и обновлять только поля с номерами страниц по F9.

И еще вопрос: во время выполнения скрипта 5-6 раз выскакивает окошко "Недостаточно памяти. Данная операция не может быть отменена после ее завершения". Можно ли от него избавиться непосредственно в макросе или в настройках  ворда (2003).

4

Re: Содержание в виде таблице по ГОСТ

По поводу второго пункта нашел вот что

Word.Application.DisplayAlerts = wdAlertsNone

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

5

Re: Содержание в виде таблице по ГОСТ

Ужасно извиняюсь. Посмотрел в ГОСТе. Там оказывается стоит значение min для высоты строки, так что отбой. Всем спасибо  smile

6

Re: Содержание в виде таблице по ГОСТ

Совсем забыл! Для получения всех заголовков, на которые можно поставить ссылку, следует использовать метод GetCrossReferenceItems:

Dim myHeadings
myHeadings = ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)
For i = LBound(myHeadings) To UBound(myHeadings)
        'во вторую колонку вносим номер заголовка
        oTable.Cell(i + 1, 2).Select
        Selection.MoveLeft
        Selection.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdNumberFullContext, ReferenceItem:=i, InsertAsHyperlink:=True
        Selection.TypeText Text:=". "
        ' и название
        Selection.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdContentText, ReferenceItem:=i, InsertAsHyperlink:=True
        ' ОПРЕДЕЛЯЕМ ДЛИНУ СТРОКИ ВО ВТОРОЙ ЯЧЕЙКЕ
        strCell = oTable.Cell(i + 1, 2).Range.Text
        strLen = Len(strCell)
        If strLen > 30 Then
            'MsgBox (strCell)
        End If
        
        'в третью колонку вносим номер страницы. Выравниваем по центру
        oTable.Cell(i + 1, 3).Select
        Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        Selection.MoveLeft
        Selection.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdPageNumber, ReferenceItem:=i, InsertAsHyperlink:=True
        
        'добавляем строку перед последней
        oTable.Rows.Add (oTable.Rows(oTable.Rows.Count))
Next
Лучше день потерять — потом за пять минут долететь!

7

Re: Содержание в виде таблице по ГОСТ

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

viter.alex пишет:

Совсем забыл! Для получения всех заголовков, на которые можно поставить ссылку, следует использовать метод GetCrossReferenceItems:

Dim myHeadings
myHeadings = ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)
For i = LBound(myHeadings) To UBound(myHeadings)
        'во вторую колонку вносим номер заголовка
        oTable.Cell(i + 1, 2).Select
        Selection.MoveLeft
        Selection.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdNumberFullContext, ReferenceItem:=i, InsertAsHyperlink:=True
        Selection.TypeText Text:=". "
        ' и название
        Selection.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdContentText, ReferenceItem:=i, InsertAsHyperlink:=True
        ' ОПРЕДЕЛЯЕМ ДЛИНУ СТРОКИ ВО ВТОРОЙ ЯЧЕЙКЕ
        strCell = oTable.Cell(i + 1, 2).Range.Text
        strLen = Len(strCell)
        If strLen > 30 Then
            'MsgBox (strCell)
        End If
        
        'в третью колонку вносим номер страницы. Выравниваем по центру
        oTable.Cell(i + 1, 3).Select
        Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        Selection.MoveLeft
        Selection.InsertCrossReference ReferenceType:="Заголовок", ReferenceKind:= _
        wdPageNumber, ReferenceItem:=i, InsertAsHyperlink:=True
        
        'добавляем строку перед последней
        oTable.Rows.Add (oTable.Rows(oTable.Rows.Count))
Next

8

Re: Содержание в виде таблице по ГОСТ

cherney, по моему, ваши старания в написании макроса всего лишь пустые хлопоты.
Читаем ГОСТ Р 21.1101-2013 СПДС. Основные требования к проектной и рабочей документации

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

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

8.6 При комплектовании нескольких документов в виде тома, альбома, а также в папку после титульного листа приводят содержание тома (альбома, папки), которое является перечнем документов, входящих в том (альбом, папку). Содержание выполняют по форме 2 (приложение Г) на листах формата А4.
Документы в содержании записывают в последовательности их комплектования в том, альбом или папку. Графические документы проектной и отчетной технической документации по инженерным изысканиям записывают полистно. Обложку и титульный лист в содержание не записывают.

В графах содержания указывают:

- в графе "Обозначение" - обозначение документа;
- в графе "Наименование" - наименование документа в полном соответствии с наименованием, указанным в основной надписи или на титульном листе;
- в графе "Примечание" - сведения об изменениях, вносимых в записанные документы, а также номер листа тома по сквозной нумерации листов тома в соответствии с 8.5, с которого начинается документ.

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

Т.е. Содержание тома заполняется примерно так:
12345-ИОС.7-С   Содержание тома     На 1 листе
12345-СП            Состав проектной документации  На 2-х листах
12345-ИОС.7-ТЧ Технологические решения. Текстовая часть  На 74-х листах
12345-ИОС.7-ГЧ.1 Принципиальная технологическая схема  На 1-м листе
12345-ИОС.7-ГЧ.2 План расположения оборудования   На 1-м листе
.........Полистно перечисляем чертежи графической части.....

Еще один пункт из ГОСТ Р 21.1101-2013
"4.1.7 Текстовые документы, содержащие, в основном, сплошной текст (в том числе текстовые части разделов и подразделов проектной документации), выполняют по ГОСТ 2.105 с учетом 5.1, 5.2 настоящего стандарта."

Смотрим ГОСТ 2.105
"4.1.11 В документе (части, книге) большого объема на первом (заглавном) листе и, при необходимости, на последующих листах помещают содержание, включающее номера и наименования разделов и подразделов с указанием номеров листов (страниц)"....

Содержание текстовой части в соответствии с ГОСТ 2.105 оформляется гладким текстом (таблица не требуется)